# @dapp-format 1
# @id tracker-music
# @name Tracker Music
# @version 1.4.0
# @boards fnk0104
# @runtime >=1.8.0 <2.0.0
# @echo off
# @summary An eight-pattern song sequencer for the three-channel synth
# /apps/tracker-music.dapp
# Arrows move, space toggles a step, 1-6 set the selected note tone, [] changes
# pattern, comma/dot moves the song cursor, A assigns pattern to song, P plays
# song, +/- changes tempo, Enter plays one loop, W cycles the current channel's
# waveform (sine/triangle/square/sawtooth/noise), H/? helps, S opens save
# browser, L opens load browser, C clears the current pattern, X trims song
# length, Escape exits.

CANVAS 60 20
DIM p1 128
DIM p2 128
DIM p3 128
DIM t1 128
DIM t2 128
DIM t3 128
DIM f1 6
DIM f2 6
DIM f3 6
DIM song 16
SET f1[0] 110
SET f1[1] 131
SET f1[2] 147
SET f1[3] 165
SET f1[4] 196
SET f1[5] 220
SET f2[0] 220
SET f2[1] 262
SET f2[2] 294
SET f2[3] 330
SET f2[4] 392
SET f2[5] 440
SET f3[0] 880
SET f3[1] 1200
SET f3[2] 1800
SET f3[3] 2600
SET f3[4] 4000
SET f3[5] 6500
SET channel 1
SET step 0
SET pattern 0
SET patternCount 8
SET totalsteps 128
SET songpos 0
SET songLen 1
SET bpm 120
SET tone1 0
SET tone2 2
SET tone3 3
SET wave1 2
SET wave2 1
SET wave3 4
SETSTR saveDir "/apps"
SETSTR saveName "tracker-music.dat"
SETSTR savePath "/apps/tracker-music.dat"
SETSTR browseMode "save"
GOSUB inittones
GOSUB initsong
GOSUB load
GOSUB draw

:loop
KEY k
IF $k = 0 GOTO wait
IF $k = $kesc GOTO leave
IF $k = $kleft GOTO left
IF $k = $kright GOTO right
IF $k = $kup GOTO up
IF $k = $kdown GOTO down
IF $k = $kspace GOTO toggle
IF $k = $kenter GOTO play
IF $k = 112 GOTO playsong
IF $k = 80 GOTO playsong
IF $k = 43 GOTO faster
IF $k = 45 GOTO slower
IF $k = 44 GOTO prevsong
IF $k = 46 GOTO nextsong
IF $k = 91 GOTO prevpattern
IF $k = 93 GOTO nextpattern
IF $k = 97 GOTO assignsong
IF $k = 65 GOTO assignsong
IF $k = 120 GOTO trimsong
IF $k = 88 GOTO trimsong
IF $k = 115 GOTO savekey
IF $k = 83 GOTO savekey
IF $k = 108 GOTO loadkey
IF $k = 76 GOTO loadkey
IF $k = 99 GOTO clearkey
IF $k = 67 GOTO clearkey
IF $k = 119 GOTO cyclewave
IF $k = 87 GOTO cyclewave
IF $k = 104 GOTO helpkey
IF $k = 72 GOTO helpkey
IF $k = 63 GOTO helpkey
IF $k < 49 GOTO wait
IF $k > 54 GOTO wait
EXPR tone $k - 49
EXPR idx $pattern * 16 + $step
IF $channel = 1 GOTO setnote1
IF $channel = 2 GOTO setnote2
SET tone3 $tone
SET t3[$idx] $tone
SET p3[$idx] 1
GOTO redraw
:setnote1
SET tone1 $tone
SET t1[$idx] $tone
SET p1[$idx] 1
GOTO redraw
:setnote2
SET tone2 $tone
SET t2[$idx] $tone
SET p2[$idx] 1
GOTO redraw

:cyclewave
IF $channel = 1 GOTO cyclewave1
IF $channel = 2 GOTO cyclewave2
ADD wave3 1
IF $wave3 <= 4 GOTO redraw
SET wave3 0
GOTO redraw
:cyclewave1
ADD wave1 1
IF $wave1 <= 4 GOTO redraw
SET wave1 0
GOTO redraw
:cyclewave2
ADD wave2 1
IF $wave2 <= 4 GOTO redraw
SET wave2 0
GOTO redraw

:left
SUB step 1
IF $step >= 0 GOTO redraw
SET step 15
GOTO redraw
:right
ADD step 1
IF $step <= 15 GOTO redraw
SET step 0
GOTO redraw
:up
SUB channel 1
IF $channel >= 1 GOTO redraw
SET channel 3
GOTO redraw
:down
ADD channel 1
IF $channel <= 3 GOTO redraw
SET channel 1
GOTO redraw

:prevpattern
SUB pattern 1
IF $pattern >= 0 GOTO redraw
EXPR pattern $patternCount - 1
GOTO redraw
:nextpattern
ADD pattern 1
IF $pattern < $patternCount GOTO redraw
SET pattern 0
GOTO redraw

:prevsong
SUB songpos 1
IF $songpos >= 0 GOTO redraw
EXPR songpos $songLen - 1
GOTO redraw
:nextsong
ADD songpos 1
IF $songpos < 16 GOTO nextsong_len
SET songpos 0
GOTO redraw
:nextsong_len
IF $songpos < $songLen GOTO redraw
EXPR songLen $songpos + 1
GOTO redraw
:assignsong
SET song[$songpos] $pattern
GOTO redraw
:trimsong
EXPR songLen $songpos + 1
GOTO redraw

:toggle
EXPR idx $pattern * 16 + $step
IF $channel = 1 GOTO tog1
IF $channel = 2 GOTO tog2
EXPR p3[$idx] 1 - $p3[$idx]
IF $p3[$idx] = 0 GOTO redraw
SET t3[$idx] $tone3
GOTO redraw
:tog1
EXPR p1[$idx] 1 - $p1[$idx]
IF $p1[$idx] = 0 GOTO redraw
SET t1[$idx] $tone1
GOTO redraw
:tog2
EXPR p2[$idx] 1 - $p2[$idx]
IF $p2[$idx] = 0 GOTO redraw
SET t2[$idx] $tone2
GOTO redraw

:faster
ADD bpm 10
IF $bpm <= 300 GOTO redraw
SET bpm 300
GOTO redraw
:slower
SUB bpm 10
IF $bpm >= 30 GOTO redraw
SET bpm 30
GOTO redraw

:play
SET playpat $pattern
GOSUB playpat
GOTO redraw

:playsong
SET songplay 0
:playsong_loop
IF $songplay >= $songLen GOTO playsong_done
SET songpos $songplay
SET pattern $song[$songpos]
SET playpat $pattern
GOSUB playpat
IF $playabort = 1 GOTO playsong_done
ADD songplay 1
GOTO playsong_loop
:playsong_done
WAVESTOP
GOTO redraw

:playpat
SET playabort 0
EXPR delayms 15000 / $bpm
SET playstep 0
:playloop
EXPR playidx $playpat * 16 + $playstep
WAVESTOP
IF $p1[$playidx] = 0 GOTO pl2
SET playtone $t1[$playidx]
SET widx $wave1
GOSUB wavename
WAVE 1 $wname $f1[$playtone] 22
:pl2
IF $p2[$playidx] = 0 GOTO pl3
SET playtone $t2[$playidx]
SET widx $wave2
GOSUB wavename
WAVE 2 $wname $f2[$playtone] 18
:pl3
IF $p3[$playidx] = 0 GOTO plwait
SET playtone $t3[$playidx]
SET widx $wave3
GOSUB wavename
WAVE 3 $wname $f3[$playtone] 12
:plwait
SET step $playstep
GOSUB draw
WAIT $delayms
KEY k
IF $k = $kesc GOTO playdone
ADD playstep 1
IF $playstep < 16 GOTO playloop
:playdone
IF $k = $kesc GOTO playabort
WAVESTOP
RETURN
:playabort
SET playabort 1
WAVESTOP
RETURN

:savekey
GOSUB savebrowser
GOTO redraw
:loadkey
GOSUB loadbrowser
GOTO redraw
:clearkey
SET i 0
:clearloop
IF $i >= 16 GOTO redraw
EXPR idx $pattern * 16 + $i
SET p1[$idx] 0
SET p2[$idx] 0
SET p3[$idx] 0
SET t1[$idx] $tone1
SET t2[$idx] $tone2
SET t3[$idx] $tone3
ADD i 1
GOTO clearloop

:helpkey
GOSUB help
GOTO redraw

:redraw
GOSUB draw
:wait
WAIT 16
GOTO loop

:draw
CLS
EXPR idx $pattern * 16 + $step
IF $channel = 1 GOTO cur1
IF $channel = 2 GOTO cur2
SET curtone $t3[$idx]
SET curwave $wave3
GOTO curdone
:cur1
SET curtone $t1[$idx]
SET curwave $wave1
GOTO curdone
:cur2
SET curtone $t2[$idx]
SET curwave $wave2
:curdone
EXPR curmark $curtone + 1
EXPR patdisp $pattern + 1
EXPR songdisp $songpos + 1
SET widx $curwave
GOSUB wavename
COLOR pink
PUT 0 0 "TRACKER MUSIC"
COLOR white
PUT 0 1 "PAT $patdisp/8  SONG $songdisp/$songLen  BPM $bpm"
PUT 0 2 "CH $channel  TONE $curmark  WAVE $wlabel"
COLOR cyan
PUT 0 4 "    1 2 3 4 5 6 7 8 9 A B C D E F G"
SET i 0
:drawloop
IF $i >= 16 GOTO drawcursor
EXPR idx $pattern * 16 + $i
EXPR x 4 + $i * 2
IF $p1[$idx] = 0 GOTO d1off
COLOR pink
EXPR mark $t1[$idx] + 1
PUT $x 7 "$mark"
GOTO d2
:d1off
COLOR white
PUT $x 7 "."
:d2
IF $p2[$idx] = 0 GOTO d2off
COLOR cyan
EXPR mark $t2[$idx] + 1
PUT $x 10 "$mark"
GOTO d3
:d2off
COLOR white
PUT $x 10 "."
:d3
IF $p3[$idx] = 0 GOTO d3off
COLOR yellow
EXPR mark $t3[$idx] + 1
PUT $x 13 "$mark"
GOTO dn
:d3off
COLOR white
PUT $x 13 "."
:dn
ADD i 1
GOTO drawloop
:drawcursor
COLOR white
SET widx $wave1
GOSUB wavename
PUT 0 7 "$wlabel"
SET widx $wave2
GOSUB wavename
PUT 0 10 "$wlabel"
SET widx $wave3
GOSUB wavename
PUT 0 13 "$wlabel"
EXPR x 4 + $step * 2
EXPR y 4 + $channel * 3
COLOR green
PUT $x $y "@"
COLOR cyan
PUT 0 16 "SEQ"
SET i 0
:drawsong
IF $i >= $songLen GOTO drawsong_done
EXPR x 4 + $i * 2
EXPR mark $song[$i] + 1
IF $i = $songpos GOTO drawsong_sel
COLOR white
PUT $x 16 "$mark"
GOTO drawsong_next
:drawsong_sel
COLOR green
PUT $x 16 "$mark"
:drawsong_next
ADD i 1
GOTO drawsong
:drawsong_done
COLOR yellow
PUT 0 18 "arrows move space toggle [] pattern ,/. song A assign"
PUT 0 19 "enter pat P song +/- tempo H/? help S save L load esc"
FLIP
RETURN

:help
WAVESTOP
CLS
COLOR pink
PUT 0 0 "TRACKER MUSIC CONTROLS"
COLOR white
PUT 0 2 "arrows  move channels and steps"
PUT 0 4 "space   toggle note    1-6 set tone"
PUT 0 6 "enter   play pattern   P play song"
PUT 0 8 "[ / ]   switch pattern"
PUT 0 9 "W       cycle channel's waveform"
PUT 0 10 ", / .   move song cursor, . extends"
PUT 0 12 "A       assign pattern to song slot"
PUT 0 14 "S       save browser   L load browser"
PUT 0 16 "N       new dir in save/load browser"
PUT 0 18 "+/- tempo  C clear pattern  X trim  esc quit"
COLOR cyan
PUT 0 19 "SIN/TRI/SQR/SAW/NSE = waveform. Any key returns."
FLIP
:helpwait
WAIT 16
KEY hk
IF $hk = 0 GOTO helpwait
RETURN

#looks up $widx (0=sine 1=triangle 2=square 3=sawtooth, else noise) into
#$wname (the WAVE opcode's kind argument) and $wlabel (3-char row display)
:wavename
IF $widx = 0 GOTO wn_sine
IF $widx = 1 GOTO wn_tri
IF $widx = 2 GOTO wn_sq
IF $widx = 3 GOTO wn_saw
SETSTR wname "noise"
SETSTR wlabel "NSE"
RETURN
:wn_sine
SETSTR wname "sine"
SETSTR wlabel "SIN"
RETURN
:wn_tri
SETSTR wname "triangle"
SETSTR wlabel "TRI"
RETURN
:wn_sq
SETSTR wname "square"
SETSTR wlabel "SQR"
RETURN
:wn_saw
SETSTR wname "sawtooth"
SETSTR wlabel "SAW"
RETURN

:inittones
SET i 0
:initloop
IF $i >= $totalsteps GOTO initdone
SET t1[$i] $tone1
SET t2[$i] $tone2
SET t3[$i] $tone3
ADD i 1
GOTO initloop
:initdone
RETURN

:initsong
SET songpos 0
SET songLen 1
SET i 0
:initsong_loop
IF $i >= 16 GOTO initsong_done
SET song[$i] 0
ADD i 1
GOTO initsong_loop
:initsong_done
RETURN

:savebrowser
WAVESTOP
SETSTR browseMode "save"
SET savePick 0
SET savePage 0
SETSTR saveMsg ""
GOTO sb_loop
:loadbrowser
WAVESTOP
SETSTR browseMode "load"
SET savePick 0
SET savePage 0
SETSTR saveMsg ""
:sb_loop
GOSUB sb_draw
WAIT 16
KEY sk
IF $sk = 0 GOTO sb_loop
IF $sk = $kesc GOTO sb_done
IF $sk = $kup GOTO sb_up
IF $sk = $kdown GOTO sb_down
IF $sk = $kenter GOTO sb_enter
IF $sk = $kback GOTO sb_parent_key
IF $sk = 117 GOTO sb_parent_key
IF $sk = 85 GOTO sb_parent_key
IF $sk = 110 GOTO sb_mkdir
IF $sk = 78 GOTO sb_mkdir
IF $sk = 115 GOTO sb_saveas
IF $sk = 83 GOTO sb_saveas
GOTO sb_loop
:sb_up
SUB savePick 1
IF $savePick >= 0 GOTO sb_up_page
SET savePick 0
:sb_up_page
EXPR minpick $savePage * 10
IF $savePick >= $minpick GOTO sb_loop
SUB savePage 1
IF $savePage >= 0 GOTO sb_loop
SET savePage 0
GOTO sb_loop
:sb_down
GOSUB sb_refresh_count
IF $saveCount <= 0 GOTO sb_loop
ADD savePick 1
IF $savePick < $saveCount GOTO sb_down_page
EXPR savePick $saveCount - 1
:sb_down_page
EXPR nextpage $savePage + 1
EXPR maxpick $nextpage * 10
IF $savePick < $maxpick GOTO sb_loop
ADD savePage 1
GOTO sb_loop
:sb_enter
GOSUB sb_select
IF $selected = 0 GOTO sb_loop
IFEQ $sbtype "D" GOTO sb_opendir
IFEQ $browseMode "load" GOTO sb_loadfile
GOTO sb_loop
:sb_loadfile
GOSUB sb_join_entry
SETSTR savePath $saveTarget
GOSUB load
GOTO sb_done
:sb_opendir
GOSUB sb_join_entry
SETSTR saveDir $saveTarget
SET savePick 0
SET savePage 0
SETSTR saveMsg ""
GOTO sb_loop
:sb_parent_key
GOSUB sb_parent
SET savePick 0
SET savePage 0
SETSTR saveMsg ""
GOTO sb_loop
:sb_mkdir
INPUT saveName "directory name> "
LEN n $saveName
IF $n = 0 GOTO sb_loop
GOSUB sb_join
FMKDIR $saveTarget
IF $fok = 1 GOTO sb_mkdir_ok
SETSTR saveMsg "could not create directory"
GOTO sb_loop
:sb_mkdir_ok
SETSTR saveDir $saveTarget
SET savePick 0
SET savePage 0
SETSTR saveMsg "directory created"
GOTO sb_loop
:sb_saveas
IFEQ $browseMode "load" GOTO sb_loop
INPUT saveName "save name> "
LEN n $saveName
IF $n = 0 GOTO sb_loop
GOSUB sb_join
SETSTR savePath $saveTarget
GOSUB save
IF $fok = 1 GOTO sb_done
SETSTR saveMsg "save failed"
GOTO sb_loop
:sb_done
FDELETE "/tracker-save.list"
RETURN

:sb_draw
CLS
COLOR pink
SETSTR sbtitle "SAVE TRACKER"
IFEQ $browseMode "load" GOTO sb_draw_title_load
GOTO sb_draw_title_done
:sb_draw_title_load
SETSTR sbtitle "LOAD TRACKER"
:sb_draw_title_done
PUT 0 0 "$sbtitle"
COLOR white
PUT 0 2 "$saveDir"
GOSUB sb_refresh_count
IF $fok = 0 GOTO sb_draw_fail
FOPEN "/tracker-save.list" read
IF $fok = 0 GOTO sb_draw_fail
EXPR skip $savePage * 10
SET index 0
:sb_skip
IF $index >= $skip GOTO sb_show
FREAD line
IF $feof = 1 GOTO sb_empty
ADD index 1
GOTO sb_skip
:sb_show
SET shown 0
:sb_show_one
IF $shown >= 10 GOTO sb_draw_footer
FREAD line
IF $feof = 1 GOTO sb_draw_footer
GOSUB sb_parserow
EXPR row 4 + $shown
SUBSTR showname $sbname 0 42
IF $index = $savePick GOTO sb_show_sel
COLOR white
GOTO sb_show_color
:sb_show_sel
COLOR green
:sb_show_color
IFEQ $sbtype "D" GOTO sb_show_dir
PUT 2 $row "$showname"
GOTO sb_show_next
:sb_show_dir
PUT 2 $row "[$showname]"
:sb_show_next
ADD shown 1
ADD index 1
GOTO sb_show_one
:sb_empty
COLOR white
PUT 2 5 "(empty)"
:sb_draw_footer
FCLOSE
COLOR yellow
PUT 0 15 "$saveMsg"
PUT 0 16 "up/down choose  enter open  bksp/u up"
IFEQ $browseMode "load" GOTO sb_draw_footer_load
PUT 0 17 "S save here  N new dir  esc cancel"
PUT 0 19 "file: $saveName"
GOTO sb_draw_footer_done
:sb_draw_footer_load
PUT 0 17 "enter loads file  N new dir  esc cancel"
:sb_draw_footer_done
FLIP
RETURN
:sb_draw_fail
FCLOSE
COLOR red
PUT 0 5 "cannot list directory"
COLOR yellow
PUT 0 17 "bksp/u up  esc cancel"
FLIP
RETURN

:sb_refresh_count
FLIST $saveDir "/tracker-save.list"
IF $fok = 0 GOTO sb_count_fail
SET saveCount 0
FOPEN "/tracker-save.list" read
IF $fok = 0 GOTO sb_count_done
:sb_count_loop
FREAD line
IF $feof = 1 GOTO sb_count_done
ADD saveCount 1
GOTO sb_count_loop
:sb_count_fail
SET saveCount 0
:sb_count_done
FCLOSE
RETURN

:sb_select
SET selected 0
GOSUB sb_refresh_count
IF $saveCount <= 0 GOTO sb_select_done
IF $savePick < $saveCount GOTO sb_select_open
EXPR savePick $saveCount - 1
:sb_select_open
FOPEN "/tracker-save.list" read
IF $fok = 0 GOTO sb_select_done
SET index 0
:sb_select_loop
FREAD line
IF $feof = 1 GOTO sb_select_done
IF $index = $savePick GOTO sb_select_found
ADD index 1
GOTO sb_select_loop
:sb_select_found
GOSUB sb_parserow
SET selected 1
:sb_select_done
FCLOSE
RETURN

:sb_parserow
SUBSTR sbtype $line 0 1
LEN linelen $line
SET i 2
:sb_prscan
IF $i >= $linelen GOTO sb_prbad
CHARAT ch $line $i
IF $ch = 124 GOTO sb_prfound
ADD i 1
GOTO sb_prscan
:sb_prfound
EXPR count $i - 2
SUBSTR sbname $line 2 $count
RETURN
:sb_prbad
SETSTR sbtype "?"
SETSTR sbname $line
RETURN

:sb_join
IFEQ $saveDir "/" GOTO sb_joinroot
SETSTR saveTarget $saveDir
APPEND saveTarget "/"
APPEND saveTarget $saveName
RETURN
:sb_joinroot
SETSTR saveTarget "/"
APPEND saveTarget $saveName
RETURN

:sb_join_entry
IFEQ $saveDir "/" GOTO sb_join_entry_root
SETSTR saveTarget $saveDir
APPEND saveTarget "/"
APPEND saveTarget $sbname
RETURN
:sb_join_entry_root
SETSTR saveTarget "/"
APPEND saveTarget $sbname
RETURN

:sb_parent
IFEQ $saveDir "/" GOTO sb_parent_done
LEN n $saveDir
SET i 0
SET last 0
:sb_parscan
IF $i >= $n GOTO sb_parcut
CHARAT ch $saveDir $i
IF $ch <> 47 GOTO sb_parnext
SET last $i
:sb_parnext
ADD i 1
GOTO sb_parscan
:sb_parcut
IF $last > 0 GOTO sb_parsub
SETSTR saveDir "/"
RETURN
:sb_parsub
SUBSTR saveDir $saveDir 0 $last
:sb_parent_done
RETURN

:save
FOPEN $savePath write
IF $fok = 0 GOTO svdone
FWRITE "TM4"
FWRITE "$bpm"
FWRITE "$tone1 $tone2 $tone3"
FWRITE "$wave1 $wave2 $wave3"
FWRITE "$pattern"
FWRITE "$patternCount"
FWRITE "$songpos"
FWRITE "$songLen"
SETSTR line ""
SET i 0
:svsong
IF $i >= 16 GOTO svsong_write
SET val $song[$i]
ADD val 48
CHR one $val
APPEND line $one
ADD i 1
GOTO svsong
:svsong_write
FWRITE "$line"
SET pat 0
:svpat
IF $pat >= $patternCount GOTO svdone
SET row 1
:svrow
IF $row > 3 GOTO svtones
SETSTR line ""
SET i 0
:svbits
IF $i >= 16 GOTO svwrite
EXPR idx $pat * 16 + $i
IF $row = 1 GOTO sv1
IF $row = 2 GOTO sv2
SET bit $p3[$idx]
GOTO svadd
:sv1
SET bit $p1[$idx]
GOTO svadd
:sv2
SET bit $p2[$idx]
:svadd
IF $bit = 0 GOTO svzero
APPEND line "1"
GOTO svn
:svzero
APPEND line "0"
:svn
ADD i 1
GOTO svbits
:svwrite
FWRITE "$line"
ADD row 1
GOTO svrow
:svtones
SET row 1
:svtrow
IF $row > 3 GOTO svnextpat
SETSTR line ""
SET i 0
:svtbits
IF $i >= 16 GOTO svtwrite
EXPR idx $pat * 16 + $i
IF $row = 1 GOTO svt1
IF $row = 2 GOTO svt2
SET val $t3[$idx]
GOTO svtadd
:svt1
SET val $t1[$idx]
GOTO svtadd
:svt2
SET val $t2[$idx]
:svtadd
ADD val 48
CHR one $val
APPEND line $one
ADD i 1
GOTO svtbits
:svtwrite
FWRITE "$line"
ADD row 1
GOTO svtrow
:svnextpat
ADD pat 1
GOTO svpat
:svdone
FCLOSE
RETURN

:load
FEXISTS have $savePath
IF $have = 0 GOTO lddone
FOPEN $savePath read
IF $fok = 0 GOTO lddone
FREAD text
IFEQ $text "TM4" GOTO ldv4
IFEQ $text "TM3" GOTO ldv3
IFEQ $text "TM2" GOTO ldv2
GOSUB str2num
IF $got = 0 GOTO lddone
SET bpm $num
FREAD line
SET pos 0
GOSUB readnum
SET tone1 $num
GOSUB readnum
SET tone2 $num
GOSUB readnum
SET tone3 $num
GOSUB inittones
SET pat 0
SET ldabort 0
GOSUB loadpat
GOTO lddone

:ldv4
FREAD text
GOSUB str2num
IF $got = 1 GOTO ldv4_bpm
GOTO ldv4_tones
:ldv4_bpm
SET bpm $num
:ldv4_tones
FREAD line
SET pos 0
GOSUB readnum
SET tone1 $num
GOSUB readnum
SET tone2 $num
GOSUB readnum
SET tone3 $num
GOSUB inittones
FREAD line
SET pos 0
GOSUB readnum
SET wave1 $num
GOSUB readnum
SET wave2 $num
GOSUB readnum
SET wave3 $num
GOSUB clampwaves
FREAD text
GOSUB str2num
IF $got = 1 GOTO ldv4_pattern
GOTO ldv4_count
:ldv4_pattern
SET pattern $num
IF $pattern >= 0 GOTO ldv4_pat_hi
SET pattern 0
:ldv4_pat_hi
IF $pattern < $patternCount GOTO ldv4_count
EXPR pattern $patternCount - 1
:ldv4_count
FREAD text
GOSUB str2num
IF $got = 1 GOTO ldv4_count_ok
SET loadpatterns $patternCount
GOTO ldv4_songpos
:ldv4_count_ok
SET loadpatterns $num
IF $loadpatterns >= 1 GOTO ldv4_count_high
SET loadpatterns 1
:ldv4_count_high
IF $loadpatterns <= $patternCount GOTO ldv4_songpos
SET loadpatterns $patternCount
:ldv4_songpos
FREAD text
GOSUB str2num
IF $got = 1 GOTO ldv4_songpos_ok
GOTO ldv4_songlen
:ldv4_songpos_ok
SET songpos $num
IF $songpos >= 0 GOTO ldv4_songpos_hi
SET songpos 0
:ldv4_songpos_hi
IF $songpos < 16 GOTO ldv4_songlen
SET songpos 15
:ldv4_songlen
FREAD text
GOSUB str2num
IF $got = 1 GOTO ldv4_songlen_ok
GOTO ldv4_songline
:ldv4_songlen_ok
SET songLen $num
IF $songLen >= 1 GOTO ldv4_songlen_hi
SET songLen 1
:ldv4_songlen_hi
IF $songLen <= 16 GOTO ldv4_songpos_len
SET songLen 16
:ldv4_songpos_len
IF $songpos < $songLen GOTO ldv4_songline
EXPR songpos $songLen - 1
:ldv4_songline
FREAD line
IF $feof = 1 GOTO lddone
SET i 0
:ldv4_songread
IF $i >= 16 GOTO ldv4_read
CHARAT val $line $i
IF $val < 48 GOTO ldv4_songnext
IF $val > 55 GOTO ldv4_songnext
SUB val 48
SET song[$i] $val
:ldv4_songnext
ADD i 1
GOTO ldv4_songread
:ldv4_read
SET pat 0
SET ldabort 0
:ldv4_pat
IF $pat >= $loadpatterns GOTO lddone
GOSUB loadpat
IF $ldabort = 1 GOTO lddone
ADD pat 1
GOTO ldv4_pat

:ldv3
FREAD text
GOSUB str2num
IF $got = 1 GOTO ldv3_bpm
GOTO ldv3_tones
:ldv3_bpm
SET bpm $num
:ldv3_tones
FREAD line
SET pos 0
GOSUB readnum
SET tone1 $num
GOSUB readnum
SET tone2 $num
GOSUB readnum
SET tone3 $num
GOSUB inittones
FREAD text
GOSUB str2num
IF $got = 1 GOTO ldv3_pattern
GOTO ldv3_count
:ldv3_pattern
SET pattern $num
IF $pattern >= 0 GOTO ldv3_pat_hi
SET pattern 0
:ldv3_pat_hi
IF $pattern < $patternCount GOTO ldv3_count
EXPR pattern $patternCount - 1
:ldv3_count
FREAD text
GOSUB str2num
IF $got = 1 GOTO ldv3_count_ok
SET loadpatterns $patternCount
GOTO ldv3_songpos
:ldv3_count_ok
SET loadpatterns $num
IF $loadpatterns >= 1 GOTO ldv3_count_high
SET loadpatterns 1
:ldv3_count_high
IF $loadpatterns <= $patternCount GOTO ldv3_songpos
SET loadpatterns $patternCount
:ldv3_songpos
FREAD text
GOSUB str2num
IF $got = 1 GOTO ldv3_songpos_ok
GOTO ldv3_songlen
:ldv3_songpos_ok
SET songpos $num
IF $songpos >= 0 GOTO ldv3_songpos_hi
SET songpos 0
:ldv3_songpos_hi
IF $songpos < 16 GOTO ldv3_songlen
SET songpos 15
:ldv3_songlen
FREAD text
GOSUB str2num
IF $got = 1 GOTO ldv3_songlen_ok
GOTO ldv3_songline
:ldv3_songlen_ok
SET songLen $num
IF $songLen >= 1 GOTO ldv3_songlen_hi
SET songLen 1
:ldv3_songlen_hi
IF $songLen <= 16 GOTO ldv3_songpos_len
SET songLen 16
:ldv3_songpos_len
IF $songpos < $songLen GOTO ldv3_songline
EXPR songpos $songLen - 1
:ldv3_songline
FREAD line
IF $feof = 1 GOTO lddone
SET i 0
:ldv3_songread
IF $i >= 16 GOTO ldv3_read
CHARAT val $line $i
IF $val < 48 GOTO ldv3_songnext
IF $val > 55 GOTO ldv3_songnext
SUB val 48
SET song[$i] $val
:ldv3_songnext
ADD i 1
GOTO ldv3_songread
:ldv3_read
SET pat 0
SET ldabort 0
:ldv3_pat
IF $pat >= $loadpatterns GOTO lddone
GOSUB loadpat
IF $ldabort = 1 GOTO lddone
ADD pat 1
GOTO ldv3_pat

:ldv2
FREAD text
GOSUB str2num
IF $got = 1 GOTO ldv2_bpm
GOTO ldv2_tones
:ldv2_bpm
SET bpm $num
:ldv2_tones
FREAD line
SET pos 0
GOSUB readnum
SET tone1 $num
GOSUB readnum
SET tone2 $num
GOSUB readnum
SET tone3 $num
GOSUB inittones
FREAD text
GOSUB str2num
IF $got = 1 GOTO ldv2_pattern
GOTO ldv2_count
:ldv2_pattern
SET pattern $num
IF $pattern >= 0 GOTO ldv2_pat_hi
SET pattern 0
:ldv2_pat_hi
IF $pattern < $patternCount GOTO ldv2_count
EXPR pattern $patternCount - 1
:ldv2_count
FREAD text
GOSUB str2num
IF $got = 1 GOTO ldv2_count_ok
SET loadpatterns $patternCount
GOTO ldv2_count_clamp
:ldv2_count_ok
SET loadpatterns $num
:ldv2_count_clamp
IF $loadpatterns >= 1 GOTO ldv2_count_high
SET loadpatterns 1
:ldv2_count_high
IF $loadpatterns <= $patternCount GOTO ldv2_read
SET loadpatterns $patternCount
:ldv2_read
SET pat 0
SET ldabort 0
:ldv2_pat
IF $pat >= $loadpatterns GOTO lddone
GOSUB loadpat
IF $ldabort = 1 GOTO lddone
ADD pat 1
GOTO ldv2_pat

:loadpat
SET row 1
:ldrow
IF $row > 3 GOTO ldtones
FREAD line
IF $feof = 1 GOTO ldpat_abort
SET i 0
:ldbits
IF $i >= 16 GOTO ldnext
EXPR idx $pat * 16 + $i
CHARAT bit $line $i
IF $bit = 49 GOTO ldone
SET bit 0
GOTO ldset
:ldone
SET bit 1
:ldset
IF $row = 1 GOTO ld1
IF $row = 2 GOTO ld2
SET p3[$idx] $bit
GOTO ldn
:ld1
SET p1[$idx] $bit
GOTO ldn
:ld2
SET p2[$idx] $bit
:ldn
ADD i 1
GOTO ldbits
:ldnext
ADD row 1
GOTO ldrow
:ldtones
SET row 1
:ldtrow
IF $row > 3 GOTO ldpat_done
FREAD line
IF $feof = 1 GOTO ldpat_abort
SET i 0
:ldtbits
IF $i >= 16 GOTO ldtnext
EXPR idx $pat * 16 + $i
CHARAT val $line $i
IF $val < 48 GOTO ldtn
IF $val > 53 GOTO ldtn
SUB val 48
IF $row = 1 GOTO ldt1
IF $row = 2 GOTO ldt2
SET t3[$idx] $val
GOTO ldtn
:ldt1
SET t1[$idx] $val
GOTO ldtn
:ldt2
SET t2[$idx] $val
:ldtn
ADD i 1
GOTO ldtbits
:ldtnext
ADD row 1
GOTO ldtrow
:ldpat_abort
SET ldabort 1
:ldpat_done
RETURN
:lddone
FCLOSE
RETURN

# reads the next integer from line at pos
:readnum
SETSTR text ""
:rnspace
CHARAT ch $line $pos
IF $ch <> 32 GOTO rndigits
ADD pos 1
GOTO rnspace
:rndigits
CHARAT ch $line $pos
IF $ch < 48 GOTO rnparse
IF $ch > 57 GOTO rnparse
CHR one $ch
APPEND text $one
ADD pos 1
GOTO rndigits
:rnparse
GOSUB str2num
RETURN

:str2num
SET num 0
SET got 0
SET j 0
LEN n $text
IF $n = 0 GOTO sn_done
SET got 1
:sn_loop
IF $j >= $n GOTO sn_done
CHARAT digit $text $j
IF $digit < 48 GOTO sn_bad
IF $digit > 57 GOTO sn_bad
SUB digit 48
MUL num 10
ADD num $digit
ADD j 1
GOTO sn_loop
:sn_bad
SET got 0
:sn_done
RETURN

#clamps a loaded wave1/wave2/wave3 into 0..4 (sine..noise), in case a hand-edited
#or corrupted save has something out of range
:clampwaves
IF $wave1 >= 0 GOTO cw1_hi
SET wave1 0
:cw1_hi
IF $wave1 <= 4 GOTO cw2_lo
SET wave1 4
:cw2_lo
IF $wave2 >= 0 GOTO cw2_hi
SET wave2 0
:cw2_hi
IF $wave2 <= 4 GOTO cw3_lo
SET wave2 4
:cw3_lo
IF $wave3 >= 0 GOTO cw3_hi
SET wave3 0
:cw3_hi
IF $wave3 <= 4 GOTO cwdone
SET wave3 4
:cwdone
RETURN

:leave
WAVESTOP
ENDCANVAS
PRINT "tracker-music: done"
EXIT