Home » Personal collection » Acorn ADFS disks » Greaseweazled » adfs_Dominic_1B.adf » !Atelier/Atelier
!Atelier/Atelier
This website contains an archive of files for the Acorn Electron, BBC Micro, Acorn Archimedes, Commodore 16 and Commodore 64 computers, which Dominic Ford has rescued from his private collection of floppy disks and cassettes.
Some of these files were originally commercial releases in the 1980s and 1990s, but they are now widely available online. I assume that copyright over them is no longer being asserted. If you own the copyright and would like files to be removed, please contact me.
| Tape/disk: | Home » Personal collection » Acorn ADFS disks » Greaseweazled » adfs_Dominic_1B.adf |
| Filename: | !Atelier/Atelier |
| Read OK: | ✔ |
| File size: | F39C bytes |
| Load address: | FFFFFB41 |
| Exec address: | DD63791A |
Duplicates
There are 6 duplicate copies of this file in the archive:
- Personal collection » Acorn hard disk » apps » Atelier » !Atelier/Atelier
- Personal collection » Acorn ADFS disks » Zipped » zipped_disks » 2000_apps_1 » apps1/Apps/Atelier/!Atelier/Atelier
- Personal collection » Acorn ADFS disks » Archimedes » Dominic_1.ADF » !Atelier/Atelier
- Personal collection » Acorn ADFS disks » Archimedes » Dominic_1B.ADF » !Atelier/Atelier
- Personal collection » Acorn ADFS disks » Greaseweazled » adfs_Dominic_1.adf » !Atelier/Atelier
- Personal collection » Acorn ADFS disks » Greaseweazled » adfs_Dominic_1B.adf » !Atelier/Atelier
- Personal collection » Acorn ADFS disks » Greaseweazled » adfs_1.6M_Apps1.adf » Apps/Atelier/!Atelier/Atelier
File contents
10REM> <Atelier$Dir>.Atelier
20REM By Simon Clay Copyright (c) Simon Clay, 1989
30: version$="1.02"
40
50
60ONERROR:PROCerror(ERR,REPORT$,ERL,TRUE)
70PROCinit
80ONERROR:PROCerror(ERR,REPORT$,ERL,FALSE):PROCreport
90PROCnormpoint
100IF FNokfile_at(start_file$,-1,start_t%) THEN t%=start_t%:start_t%=-1:PROCloadfile(start_file$,-1,t%)
110
120REPEAT
130SYS "Wimp_PollIdle",,q%,1E9 TO reason%
140PROCrespond(reason%)
150UNTILquit%
160PROCquit
170END
180
190DEFPROCrespond(reason%)
200PROCwaitpoint
210CASEreason%OF
220WHEN0:
230WHEN1:
240WHEN2:PROCopen(!q%,q%!4,q%!8,q%!12,q%!16,q%!20,q%!24,q%!28)
250WHEN3:PROCclosew(!q%)
260WHEN4:
270WHEN5:
280WHEN6:PROCmouse(!q%,q%!4,q%!8,q%!12,q%!16,q%!20)
290WHEN7:PROCenddrag
300WHEN8:
310WHEN9:PROCmenuselect
320WHEN10
330WHEN11
340WHEN12
350WHEN17,18:PROCumess1
360WHEN19:PROCumess2
370ENDCASE
380PROCnormpoint
390ENDPROC
400
410DEFPROCquit:PROCnormpoint
420IFFNdebug:PROCtidy:END
430$q%="TASK":SYS "Wimp_CloseDown",taskhandle%,!q%
440QUIT
450
460DEFPROCinit
470DIM q% 2500, workbuf% 100
480appl$="Atelier"
490PROCfindmos
500waiter%=0:PROCwaitpoint
510testing=FALSE
520IF os%=2 THEN SYS "OS_GetEnv" TO SA$:IF MID$(SA$,7,5)<>"-quit" THEN testing=TRUE
530PROCinit_at
540PROCcheckmos
550*fx229,1
560wimpsaved%=FALSE
570v%=FNinitwimp:IFv%<180:MODE12:PROCerr(2)
580quit%=FALSE:dialogue%=-1E9:stopreason%=-1
590ackpending%=FALSE:ackref%=-1
600dragreason%=-1:help$=""
610savereason%=-1
620PROCdefws:PROCdefmenus:PROCversion
630checkref%=-1
640as$="Are you sure ?"
650PROCbaricon
660REM find start bit
670start_file$="":start_t%=-1
680LOCAL ERROR
690ON ERROR LOCAL start_file$="":start_t%=-1:GOTO 830
700SYS "OS_GetEnv" TO r0,r1,r2
710A$=""
720IF ?r0<>0 THEN A$+=CHR$(?r0):r0+=1:GOTO 720
730IF INSTR(A$," ")<>0 THEN A$=MID$(A$,INSTR(A$," ")+1):GOTO 730
740IF A$<>"" THEN
750SYS "OS_File",5,A$ TO r0,r1,r2
760IF r0=1 THEN
770IF ((r2 AND &FFF00000)=&FFF00000) THEN start_t%=(r2 AND &FFF00)>>8
780start_file$=A$
790ENDIF
800ENDIF
810ENDIF
820REM end start bit
830ENDPROC
840
850DEFPROCversion
860LOCALT$:T$=version$:IFNOTFNprod:T$+=" *UNFINISHED*"
870PROCseti(w_pinfo%,4,"v"+T$)
880ENDPROC
890
900DEFFNprod=MID$(version$,INSTR(version$,".")+1,1)="0"
910DEFFNdebug=NOTFNprod ANDINKEY-1ANDINKEY-2
920
930DEFFNinitwimp
940$q%="TASK":SYS "Wimp_Initialise",200,!q%,"Atelier"TO!q%,taskhandle%
950=!q%
960
970DEFPROCtidy
980PROCnormpoint
990VDU4:PRINTTAB(0,2);:*fx4
1000*fx225,1
1010*fx229
1020ONERROR:REPORT:PRINT" ";ERL:END
1030ENDPROC
1040
1050DEFPROCbaricon
1060!q%=-1:q%!4=0:q%!8=0:q%!12=64:q%!16=68
1070q%!20=%11000000000010:$(q%+24)="!Atelier"
1080SYS"Wimp_CreateIcon",,q%TObaricon%
1090ENDPROC
1100
1110DEFPROCerror(err%,err$,erl%,quit%)
1120PROCnormpoint:dragreason%=-1:@%=&90A:*fx229,1
1130LOCALi%,e%,t$,T$
1140IFFNdebug:err$+=" ("+STR$ERL+")"
1150LOCALERROR
1160ONERRORLOCAL:PROCerror(ERR,REPORT$,ERL,TRUE)
1170!q%=err%:$(q%+4)=err$:SYS"Wimp_ReportError",q%,1,appl$
1180IFquit%:PROCquit
1190ENDPROC
1200
1210DEFPROCreport:IFFNdebug:VDU4:REPORT:PRINT" @ ";ERL:PROCtidy:END
1220ENDPROC
1230
1240DEFFNdir
1250LOCALT$:T$=FNArfVar(appl$+"$Dir")
1260IFT$="":T$="&.!"+appl$+"."
1270IFRIGHT$(T$)<>".":T$+="."
1280=T$
1290
1300DEFFNArfVar(A$)
1310LOCALERROR
1320ONERRORLOCALRESTOREERROR:=""
1330SYS&23,A$,workbuf%,200,0,3TO,,L%
1340workbuf%?L%=13:=$workbuf%
1350
1360DEFPROCumess1
1370ref%=q%!8:task%=q%!4:IFtask%=taskhandle%:ENDPROC
1380mess%=q%!16
1390CASEmess%OF
1400WHEN0:PROCquit
1410WHEN1:PROCdatasaved
1420WHEN2:PROCsavedata
1430WHEN3:PROCdataload
1440WHEN4:ackpending%=FALSE
1450WHEN5:PROCdataopen
1460WHEN6:
1470WHEN7:
1480WHEN8:PROCprequit
1490WHEN9:
1500WHEN&502:
1510WHEN&400C0:PROCsubmenu(q%!20,q%!24,q%!28,q%+32)
1520ENDCASE
1530ENDPROC
1540
1550DEFPROCdataopen
1560LOCALs%,t%
1570file$=FNzts(q%+44):s%=q%!36:t%=q%!40
1580IFFNokfile_at(file$,s%,t%)PROCdataloadack:PROCloadfile(file$,s%,t%)
1590ENDPROC
1600
1610DEFPROCdataload
1620LOCALs%,t%
1630file$=FNzts(q%+44):s%=q%!36:t%=q%!40
1640IFFNokfile_at(file$,s%,t%)PROCdataloadack:PROCloadfile(file$,s%,t%)
1650ENDPROC
1660
1670DEFPROCdatasaved
1680LOCALs%,t%
1690file$=FNzts(q%+44):s%=q%!36:t%=q%!40
1700IFFNokfile_at(file$,s%,t%)PROCdatasaveack
1710ENDPROC
1720
1730DEFPROCtemplate(T$)
1740PROCtemplate1(T$,q%)
1750ENDPROC
1760
1770DEFPROCtemplate1(T$,q%)
1780LOCAL c%:$workbuf%=T$
1790SYS "Wimp_LoadTemplate",,q%,curbuf%,endbuf%,-1,workbuf%TO,,curbuf%,,,,c%
1800IF c%=0 THEN ERROR 1,"Template '"+T$+"' not found"
1810ENDPROC
1820
1830DEFPROCdefws
1840LOCALI%
1850bufsz%=&1000
1860DIM buffer% bufsz%:curbuf%=buffer%:endbuf%=buffer%+bufsz%
1870SYS"Wimp_OpenTemplate",,FNdir+"AtFrm"
1880PROCtemplate("stopbox"):q%!64=1:SYS"Wimp_CreateWindow",,q%TOw_stop%
1890PROCtemplate("save"):q%!64=1:SYS"Wimp_CreateWindow",,q%TOw_save%
1900PROCtemplate("ProgInfo"):SYS"Wimp_CreateWindow",,q%TOw_pinfo%
1910SYS"Wimp_CloseTemplate"
1920free%=endbuf%-curbuf%
1930ENDPROC
1940
1950DEFPROCdefmenus
1960LOCALt$
1970DIM mlist% 32,function% 51
1980bufsz%=&200
1990DIM menufree% bufsz%:menuptr%=menufree%:menuend%=menufree%+bufsz%
2000menustart%=menufree%:RESTORE+2
2010READt$:m_save%=FNcrmenu(t$)
2020DATA"#Save,Compressed Screen}w_save%,System Screen}w_save%,Super Compacted Screen}w_save%,Super Compacted Sprite}w_save%,System Sprite(s)}w_save%,Brush Shapes}w_save%,Patterns}w_save%"
2030READt$:m_main%=FNcrmenu(t$)
2040DATA"#Atelier,Info>w_pinfo%,Save>m_save%,Quit"
2050ENDPROC
2060
2070DEFPROCfront(h%,X%,Y%)
2080PROCgetw(h%)
2090IFX%>=0x1%+=X%-x0%:x0%=X%
2100IFY%>=0y1%+=Y%-y0%:y0%=Y%
2110PROCopen(h%,x0%,y0%,x1%,y1%,scx%,scy%,-1)
2120ENDPROC
2130
2140DEFPROCtop(h%)
2150PROCgetw(h%):PROCopen(h%,x0%,y0%,x1%,y1%,scx%,scy%,-1):ENDPROC
2160
2170DEFPROCopen(oh%,ox0%,oy0%,ox1%,oy1%,oscx%,oscy%,obh%)
2180LOCALO%
2190!q%=oh%:SYS"Wimp_GetWindowState",,q%
2200PROCwimpopen
2210ENDPROC
2220
2230DEFPROCwimpopen
2240!q%=oh%:q%!4=ox0%:q%!8=oy0%:q%!12=ox1%:q%!16=oy1%
2250q%!20=oscx%:q%!24=oscy%:q%!28=obh%:SYS"Wimp_OpenWindow",,q%
2260ENDPROC
2270
2280DEFPROCclosew(!q%)
2290LOCALI%
2300SYS"Wimp_CloseWindow",,q%
2310IF!q%=dialogue%:dialreason%=-1:dialogue%=-1
2320IFdialogue%>=0:PROCclosew(dialogue%)
2330CASE!q%OF
2340WHENw_stop%:stopreason%=-1
2350ENDCASE
2360ENDPROC
2370
2380DEFFNia(h%,i%):PROCgeti(h%,i%):PROCchkii:=q%!28
2390DEFFNva(h%,i%):PROCgeti(h%,i%):PROCchkii:=q%!32
2400DEFFNil(h%,i%):PROCgeti(h%,i%):PROCchkii:=q%!36
2410
2420DEFPROCchkii:IF(q%!24AND&100)=0ERROR1,"Icon not indirected"
2430ENDPROC
2440
2450DEFPROCgeti(h%,i%):!q%=h%:q%!4=i%:SYS"Wimp_GetIconState",,q%:ENDPROC
2460
2470DEFPROCstop(r%,T$,U$,T%)
2480dialreason%=r%
2490IFINKEY-3mi%=3:PROCmstop:ENDPROC
2500PROCseti(w_stop%,0,T$):PROCseti(w_stop%,1,U$)
2510PROCunselall(w_stop%):PROCdialogue(w_stop%)
2520dialreason%=r%
2530ENDPROC
2540
2550DEFPROCdialogue(h%)
2560LOCALX%,Y%
2570IFdialogue%>=0:PROCclosew(dialogue%)
2580PROCnomenu:PROCreadpointer:X%=mx%-200:Y%=my%-85
2590IFX%<0X%=0
2600IFY%<96Y%=96
2610dialogue%=h%:PROCfront(h%,X%,Y%):PROCsetct(h%,-1,-1)
2620ENDPROC
2630
2640DEFPROCreadpointer:LOCALq%:q%=workbuf%
2650SYS"Wimp_GetPointerInfo",,q%
2660mx%=!q%:my%=q%!4:mb%=q%!8:mh%=q%!12:mi%=q%!16
2670ENDPROC
2680
2690DEFFNdialogue
2700IFdialogue%>=0ANDmh%<>dialogue%THEN
2710PROCclosew(dialogue%)
2720ENDIF
2730=FALSE
2740
2750DEFPROCmouse(mx%,my%,mb%,mh%,mi%,mo%)
2760IFdragreason%>=0ORmb%>255:ENDPROC
2770IFFNdialogue:ENDPROC
2780CASEmb%OF
2790WHEN2:PROCmenu
2800WHEN1,4:PROCselect
2810WHEN16,64:PROCstartdrag
2820ENDCASE
2830ENDPROC
2840
2850DEFPROCseti(h%,i%,T$):T$=LEFT$(T$,FNil(h%,i%)):$FNia(h%,i%)=T$
2860PROCiconupd(h%,i%):PROCgetct:IF!q%=h%ANDq%!4=i%:PROCsetct(h%,i%,LENT$)
2870ENDPROC
2880
2890DEFPROCiset(h%,i%,B%,E%):LOCALq%:q%=workbuf%
2900!q%=h%:q%!4=i%:q%!12=B%:q%!8=E%:SYS"Wimp_SetIconState",,q%:ENDPROC
2910
2920DEFPROCiconupd(h%,i%):PROCiset(h%,i%,0,0):ENDPROC
2930
2940DEFPROCreadblock(p%)
2950x0%=!p%:y0%=p%!4:x1%=p%!8:y1%=p%!12:REM physical area
2960scx%=p%!16:scy%=p%!20:bhandle%=p%!24:REM scroll offsets, stack depth
2970bx%=x0%-scx%:by%=y1%-scy%:REM calculate physical co-ords of logical area
2980ex0%=p%!40:ey0%=p%!44:ex1%=p%!48:ey1%=p%!52:REM logical area
2990gx0%=p%!24:gy0%=p%!28:gx1%=p%!32:gy1%=p%!36:REM graphics window
3000open%=(p%!28AND&10000)<>0:REM window open flag
3010ENDPROC
3020
3030DEFPROCgetw(h%)
3040!q%=h%:SYS "Wimp_GetWindowInfo",,q%
3050PROCreadblock(q%+4)
3060ENDPROC
3070
3080DEFPROCselect
3090CASEmh%OF
3100WHEN-2:enter%=0:PROCenter_atelier
3110WHENw_stop%:PROCmstop
3120WHENw_save%:PROCmsave
3130ENDCASE
3140ENDPROC
3150
3160DEFPROCmstop
3170IFmi%<3ORmi%>4ENDPROC
3180LOCALT%:T%=dialreason%:dialreason%=-1
3190IFmi%=3THEN
3200CASET%OF
3210WHEN1:PROCquit
3220ENDCASE
3230ENDIF
3240PROCclosew(w_stop%):ENDPROC
3250
3260DEFPROCmsave
3270IFmi%<>0ENDPROC
3280LOCALT$:T$=$FNia(w_save%,2):IFT$=FNleaf(T$):ERROR99,"To save, please drag the file icon to a directory viewer"
3290file$=T$:PROCsavedata1
3300ENDPROC
3310
3320DEFPROCstartdrag
3330dragreason%=-1:dragbutton%=mb%
3340CASEmh%OF
3350WHENw_save%:IFmi%=3:dragreason%=1:PROCdragicon(w_save%,3)
3360ENDCASE
3370ENDPROC
3380
3390DEFPROCenddrag
3400PROCreadpointer
3410IFmh%<>-1THEN
3420CASEdragreason%OF
3430WHEN1:file$=FNleaf($FNia(w_save%,2))
3440PROCsavereq(file$,savet%,saves%,savereason%)
3450ENDCASE
3460ENDIF
3470dragreason%=-1
3480ENDPROC
3490
3500DEFPROCunseli(h%,i%):PROCiset(h%,i%,&200000,0):ENDPROC
3510
3520DEFPROCseli(h%,i%):PROCiset(h%,i%,&200000,&200000):ENDPROC
3530
3540DEFPROCunselall(h%)
3550LOCALI%,i%:PROCwchi(h%)
3560I%=q%:REPEAT:i%=!I%:IFi%>=0:PROCunseli(h%,i%)
3570I%+=4:UNTILi%<0:ENDPROC
3580
3590DEFPROCwchi(h%):SYS "Wimp_WhichIcon",h%,q%,&200000,&200000
3600ENDPROC
3610
3620DEFPROCmenu
3630CASEmh%OF
3640WHEN-2:my%=64+3*40:PROCpop(m_main%,-1)
3650ENDCASE
3660ENDPROC
3670
3680DEFFNpar(t$,s$,RETURN i%):LOCALi1%
3690i1%=i%+1:i%=INSTR(t$+s$,s$,i1%)
3700=MID$(t$,i1%,i%-i1%)
3710
3720DEFFNcrmenu(menu$)
3730IFmenufree%+28>menuend%ERROR99,"Menu area full"
3740LOCAL m%
3750menuptr%=menufree%
3760i%=0
3770IF LEFT$(menu$,1)="#"i%=1:menutitle$=FNpar(menu$,",",i%)ELSEmenutitle$=""
3780$menuptr%=menutitle$
3790menuptr%?12=7:menuptr%?13=2:menuptr%?14=7:menuptr%?15=0
3800menuptr%!16=196-24:menuptr%!20=40:menuptr%!24=0
3810menuptr%+=28:maxx%=LENmenutitle$
3820REPEATitem$=FNpar(menu$,",",i%)
3830PROCmenuitem(item$)
3840UNTIL item$=""
3850m%=menufree%:m%!16=(maxx%*8+6)*2
3860menufree%=menuptr%
3870=m%
3880
3890DEFPROCmenuitem(text$)
3900IFtext$=""menuptr%!-24=(menuptr%!-24)OR&80:ENDPROC
3910IFmenuptr%+24>menuend%THENERROR99,"Menu area full"
3920LOCALi%,flg%
3930flg%=&00
3940i%=INSTR(text$,">")
3950IFi%>0subptr%=EVALMID$(text$,i%+1):text$=LEFT$(text$,i%-1)ELSEsubptr%=-1
3960i%=INSTR(text$,"}")
3970IFi%>0subptr%=EVALMID$(text$,i%+1):text$=LEFT$(text$,i%-1):flg%+=&08
3980IFRIGHT$(text$,1)="#"text$=LEFT$(text$):flg%+=&02
3990menuptr%!0=flg%:menuptr%!4=subptr%:menuptr%!8=&07000021
4000IFLEFT$(text$,1)="$"THEN
4010!menuptr%+=&04:menuptr%!8+=&100:i%=INSTR(text$,"(")
4020IFi%>0THENL%=VALMID$(text$,i%+1):text$=LEFT$(text$,i%-1)ELSEL%=12
4030menuptr%!12=EVALMID$(text$,2):menuptr%!16=-1:menuptr%!20=L%
4040text$=STRING$(L%," ")
4050ELSE
4060IFLENtext$<=12THEN
4070$(menuptr%+12)=text$
4080ELSE
4090I%=FNworkspace(LENtext$+1):$I%=text$
4100menuptr%!12=I%:menuptr%!16=-1:menuptr%!20=LENtext$+1
4110menuptr%!8=menuptr%!8 OR &100
4120ENDIF
4130IFLENtext$>maxx%maxx%=LENtext$
4140ENDIF
4150menuptr%+=24
4160ENDPROC
4170
4180DEFFNworkspace(L%)
4190IF curbuf%+L%>endbuf%ERROR99,"No more buffer space"
4200curbuf%+=L%:=curbuf%-L%
4210
4220DEFPROCprep(menu%,tree%)
4230LOCALI%,T$
4240PROCclearts(menu%)
4250CASEmenu%OF
4260WHENm_main%:PROCmp_main
4270ENDCASE
4280ENDPROC
4290
4300DEFPROCmp_main
4310LOCALn%,f$,s%,t%
4320IFtree%>0THEN
4330IF!mlist%=1THEN
4340n%=mlist%!4:PROCsetfile_at(n%,f$,s%,t%):PROCsaveset(f$,t%,n%,s%)
4350ENDIF
4360ENDIF
4370ENDPROC
4380
4390DEFPROCpop(menu%,tree%)
4400IFmenu%<0:ENDPROC
4410PROCprep(menu%,tree%)
4420SYS "Wimp_CreateMenu",,menu%,mx%-50,my%+32
4430openmenu%=menu%
4440ENDPROC
4450
4460DEFPROCnomenu
4470SYS"Wimp_CreateMenu",,-1:openmenu%=-1
4480ENDPROC
4490
4500DEFPROCmenuselect
4510LOCALI%
4520I%=0:REPEATmlist%!I%=q%!I%:I%+=4:UNTILq%!(I%-4)=-1
4530PROCreadpointer
4540CASEopenmenu%OF
4550WHENm_main%:PROCm_main
4560ENDCASE
4570IFmb%=1THEN
4580PROCpop(openmenu%,mlist%):ELSEPROCnomenu
4590ENDIF
4600ENDPROC
4610
4620DEFPROCm_main
4630CASE!mlist%OF
4640WHEN0:PROCdialogue(w_pinfo%)
4650WHEN2:IFFNaltered_at:PROCqquit:ELSEPROCquit
4660ENDCASE
4670ENDPROC
4680
4690DEFPROCsubmenu(menu%,X%,Y%,q%)
4700REM ;{{{{{{
4710LOCALI%
4720I%=0:REPEATmlist%!I%=q%!I%:I%+=4:UNTILq%!(I%-4)=-1
4730PROCprep(openmenu%,mlist%)
4740SYS"Wimp_CreateSubMenu",,menu%,X%,Y%
4750ENDPROC
4760
4770DEFPROCclearts(mh%):LOCALI%:I%=mh%+28
4780IFmh%<menustart%ORmh%>menuend%:ENDPROC
4790REPEAT
4800!I%=!I%ANDNOT1:I%!8=I%!8ANDNOT&400000:
4810I%+=24:UNTILI%!-24AND&80
4820ENDPROC
4830
4840DEFPROCshade(mh%,I%)
4850mh%!(28+8+24*I%)=mh%!(28+8+24*I%)OR&400000:ENDPROC
4860
4870DEFPROCtick(mh%,I%)
4880mh%!(28+24*I%)=mh%!(28+24*I%)OR&01:ENDPROC
4890
4900DEFFNcommand
4910LOCALT%,I%,T$
4920SYS"OS_GetEnv" TO T$
4930PROCstrip(T$)
4940=T$
4950
4960DEFFNparam
4970LOCALI%,T$:T$=FNcommand
4980I%=INSTR(T$," -quit "):IFI%=0:=""
4990T$=MID$(T$,I%+7):PROCstrip(T$)
5000I%=INSTR(T$," "):IFI%>0T$=MID$(T$,I%+1):PROCstrip(T$):ELSE=""
5010I%=INSTR(T$," "):IFI%>0T$=LEFT$(T$,I%-1):PROCstrip(T$)
5020=T$
5030
5040DEFFNfiletype(T$)
5050LOCALT%,U%:SYS "OS_File",5,T$ TOU%,,T%
5060IFT%=0:=-1
5070=(T%AND&FFF00)>>8
5080
5090DEFPROCwaitpoint
5100IF os%<>2 ENDPROC
5110waiter%+=1
5120SYS"Hourglass_On"
5130ENDPROC
5140
5150DEFPROCnormpoint
5160IF os%<>2 ENDPROC
5170WHILEwaiter%>0:SYS"Hourglass_Off":waiter%-=1:ENDWHILE:waiter%=0
5180ENDPROC
5190
5200DEFPROChelp
5210ENDPROC
5220
5230DEFPROCdataloadack
5240q%!0=20:q%!12=ref%:q%!16=4
5250SYS"Wimp_SendMessage",17,q%,task%
5260ENDPROC
5270
5280DEFPROCdatasaveack
5290IFFNArfVar("Wimp$Scrap")="":ERROR99,"<Wimp$Scrap> not defined"
5300!q%=60:q%!12=ref%:q%!16=2:q%!36=-1:$(q%+44)="<Wimp$Scrap>"+CHR$0
5310SYS"Wimp_SendMessage",17,q%,task%:ackref%=q%!8
5320ENDPROC
5330
5340DEFPROCsavereq(T$,t%,s%,r%)
5350savereason%=r%
5360q%!32=my%:q%!28=mx%:q%!24=mi%:q%!20=mh%
5370q%!16=1:q%!12=0:q%!36=s%:q%!40=t%:!q%=60
5380$(q%+44)=T$+CHR$0:SYS"Wimp_SendMessage",17,q%,q%!20,q%!24
5390saveref%=q%!8:ENDPROC
5400
5410DEFPROCloadmess
5420$(q%+44)=file$+CHR$0:!q%=60
5430q%!12=ref%:q%!16=3:SYS"Wimp_SendMessage",17,q%,task%
5440ackpending%=TRUE:ENDPROC
5450
5460DEFFNzts(T%):LOCALT$:T$=""
5470WHILE?T%<>0:T$+=CHR$?T%:T%+=1:ENDWHILE
5480=T$
5490
5500DEFPROCgetct:SYS"Wimp_GetCaretPosition",,q%:ENDPROC
5510
5520DEFPROCsetct(h%,i%,o%):SYS "Wimp_SetCaretPosition",h%,i%,,,-1,o%
5530ENDPROC
5540
5550DEFFNleaf(T$)
5560LOCALI%,C%
5570IF((INSTR(T$,".")=0)AND(INSTR(T$,":")=0))THEN=T$
5580I%=LEN(T$)
5590REPEAT
5600C%=ASCMID$(T$,I%,1)
5610I%-=1
5620UNTIL(I%<=0ORC%=ASC"."ORC%=ASC":")
5630IFI%>0THEN=RIGHT$(T$,LEN(T$)-I%-1)
5640=T$
5650
5660DEFPROCscrsz
5670!workbuf%=4:workbuf%!4=5:workbuf%!8=11:workbuf%!12=12:workbuf%!16=-1
5680SYS "OS_ReadVduVariables",workbuf%,workbuf%+24
5690q%!32=(workbuf%!32)<<(workbuf%!24):q%!36=(workbuf%!36)<<(workbuf%!28)
5700ENDPROC
5710
5720DEFPROCsaveset(f$,T%,r%,s%)
5730savereason%=r%:savef$=f$:savet%=T%:saves%=s%
5740PROCseti(w_save%,2,f$):$FNva(w_save%,3)="sfile_"+RIGHT$("00"+STR$~T%,3)
5750ENDPROC
5760
5770DEFPROCdragicon(h%,i%)
5780LOCALx%,y%,ys%
5790PROCgetw(h%):ys%=y1%-y0%:x%=bx%:y%=y0%-scy%
5800PROCgeti(h%,i%):q%!8+=x%:q%!12+=y%+ys%:q%!16+=x%
5810q%!20+=y%+ys%:q%!24=0:q%!28=0:!q%=0:PROCdrag5:ENDPROC
5820
5830DEFPROCdrag5:PROCreadpointer:PROCscrsz
5840q%!24-=mx%-q%!8:q%!28-=my%-q%!12:q%!32+=q%!16-mx%:q%!36+=q%!20-my%
5850q%!4=5:SYS"Wimp_DragBox",,q%:ENDPROC
5860
5870DEFPROCsavedata
5880IFq%!12<>saveref%:ENDPROC
5890file$=FNzts(q%+44)
5900PROCsavedata1
5910ENDPROC
5920
5930DEFPROCsavedata1:PROCclosew(w_save%)
5940PROCsavefile(savereason%,file$)
5950savereason%=-1:PROCloadmess
5960ENDPROC
5970
5980DEFPROCprequit
5990IFFNaltered_at:PROCackrec:PROCqquit
6000ENDPROC
6010
6020DEFPROCackrec:q%!12=ref%:SYS "Wimp_SendMessage",19,q%,task%
6030DEFPROCqquit:PROCstop(1,"Lose screen and quit Atelier",as$,-1)
6040ENDPROC
6050
6060DEFPROCenter_atelier
6070LOCALERROR:ONERRORLOCAL:RESTOREERROR:PROCrestorewimp:ERRORERR,REPORT$
6080enter%=0:PROCrun_at:PROCrestorewimp:ENDPROC
6090
6100DEFPROCsavefile(n%,f$)
6110LOCALERROR:ONERRORLOCAL:RESTOREERROR:PROCrestorewimp:ERRORERR,REPORT$
6120PROCsave_at(n%,f$):PROCrestorewimp:ENDPROC
6130
6140DEFPROCsavewimp:IFos%=1:ENDPROC
6150IF wimpsaved% THEN ENDPROC
6160wimpsaved%=TRUE
6170LOCALI%,J%:REM SYS"Wimp_CommandWindow",1
6180PROCnormpoint:mode%=MODE:PROCmode15
6190*fx229
6200ENDPROC
6210
6220DEFPROCrestorewimp:IFos%=1:ENDPROC
6230IF NOT wimpsaved% THEN ENDPROC
6240wimpsaved%=FALSE
6250*fx229,1
6260SYS "Wimp_CommandWindow",-1
6270SYS "Wimp_SetMode",mode%:OFF:SYS"Wimp_ForceRedraw",-1,-1E9,-1E9,1E9,1E9
6280ENDPROC
6290
6300DEFPROCmode15
6310LOCALERROR
6320ONERRORLOCAL:RESTOREERROR:ERROR99,"Atelier needs to use MODE 15 and there is not enough RAM! You must use the task manager to make at least 160k of screen available"
6330MODE15:ENDPROC
6340
6350DEFPROCfindmos:os%=1
6360LOCALERROR:ONERRORLOCAL:RESTOREERROR:ENDPROC
6370RESTORE+1
6380os%=2:ENDPROC
6390
6400DEFPROCcheckmos:os%=1
6410LOCALERROR:ONERRORLOCAL:RESTOREERROR:PROCmos12:END
6420RESTORE+1
6430os%=2:ENDPROC
6440
6450DEFPROCmos12
6460MODE15:OFF
6470SYS &400C0
6480enter%=0
6490PROCrun_at
6500MODE12:*desktop
6510END
6520
6530DEFPROCstore(RETURN A$,f$)
6540LOCALI%,C%,T$:T$=f$:IFT$>""THEN
6550FORI%=1TOLENT$:C%=ASCMID$(T$,I%)
6560IFC%>64ANDC%<91MID$(T$,I%,1)=CHR$(C%+32)
6570NEXT
6580ENDIF
6590IFINSTR(T$,"$scrap>")=0A$=f$
6600ENDPROC
6610
6620
6630REM ----ATELIER BITS-------------------------------------------------
6640DEFPROCrun_at
6650REM ;{{ here, copy the background screen to the foreground
6660REM ;{{ and do the biz. NB all ERROR traps etc MUST be LOCAL
6670PROCsavewimp
6680PROCnormpoint
6690VDU 23,255,255,255,255,255,255,255,255,255
6700cat%!0=148
6710cat%!4=-1
6720SYS "OS_ReadVduVariables",cat%,cat%
6730!topscreen%=!cat%
6740PROCunsetsoftkeys
6750SYS "OS_RemoveCursors"
6760PROCsetvectors
6770CALL undorestore%
6780PROCenter_action
6790CALL colour%
6800CALL mousecolour%
6810CALL liftdown%
6820VDU5:CALL helptext%
6830PROCupdate
6840PROCatelier
6850CALL liftup%
6860CALL undosave%
6870PROCunsetvectors
6880REM PROCsetsoftkeys
6890PROCrestorewimp
6900ENDPROC
6910
6920DEFPROCsetvectors
6930IF vectors_set% THEN ENDPROC
6940SYS "OS_Claim",&1D,duff_call%,0
6950PROCset_abort_traps
6960vectors_set%=TRUE
6970ENDPROC
6980
6990DEFPROCunsetvectors
7000IF NOT vectors_set% THEN ENDPROC
7010SYS "OS_Release",&1D,duff_call%,0
7020PROCunset_abort_traps
7030vectors_set%=FALSE
7040ENDPROC
7050
7060DEFPROCenter_action
7070ON ERROR LOCAL:PROCerror_at:ENDPROC
7080CASE enter% OF
7090WHEN0:REM no action,just enter
7100WHEN1:REM compacted load
7110*UnDefine
7120*SetPosition 0 1023
7130G%=cat%:$cat%=f$:CALL com_update_info%
7140OSCLI"PlotFile "+f$
7150enter%=0:PROCstore($screen_str%,f$)
7160WHEN2:$file_str%=f$ :REM sprites - handled by atelier
7170WHEN3:$cat%=f$
7180G%=cat%
7190CALL compactedload%
7200CALL undosave%
7210enter%=0
7220ENDCASE
7230ENDPROC
7240
7250DEFFNaltered_at
7260REM ;{{ return TRUE if you would lose any data if they quit just
7270REM ;{{ now (ie they have altered screen/sprites/brushes etc
7280REM ;{{ since last save/load. Just return FALSE if you don't care
7290=NOT testing
7300
7310DEFFNokfile_at(f$,s%,t%)
7320IF t%=&D7E OR t%=&D3A OR t%=&D7F OR t%=&D39 OR t%=&FF9 OR t%=&DE2 THEN =TRUE ELSE =FALSE
7330
7340DEFPROCloadfile(f$,s%,t%)
7350LOCALERROR:ONERRORLOCAL:RESTOREERROR:PROCrestorewimp:ERRORERR,REPORT$
7360PROCload_at(f$,s%,t%):PROCrestorewimp:ENDPROC
7370
7380DEFPROCload_at(f$,s%,t%)
7390CASE t% OF
7400WHEN&D7F,&FF9,&DE2
7410SYS "OS_Find",&40,f$ TO hdl%
7420SYS "OS_GBPB",4,hdl%,cat%,1
7430SYS "OS_Find",&00,hdl%
7440ENDCASE
7450CASE t% OF
7460WHEN&D7E:OSCLI"LOAD "+f$+" "+STR$~(brush%):PROCstore($brush_str%,f$)
7470WHEN&D3A:OSCLI"LOAD "+f$+" "+STR$~(brpatt%):PROCstore($pattern_str%,f$):!pm%=1
7480WHEN&D7F:enter%=1:PROCrun_at
7490WHEN&D39:PROCformula_load(f$)
7500WHEN&FF9:enter%=2:PROCstore($sprite_str%,f$):PROCrun_at
7510WHEN&DE2:enter%=3:PROCstore($screen_str%,f$):PROCrun_at
7520ENDCASE
7530ENDPROC
7540
7550DEFPROCsave_at(n%,f$)
7560CALL savecheck%
7570CASE n% OF
7580WHEN0,1,2,3
7590SYS "OS_File",&0A,f$,&FFF,,cat%,cat% :REM saves dummy file
7600PROCsavewimp
7610cat%!0=148:cat%!4=-1
7620SYS "OS_ReadVduVariables",cat%,cat%
7630!topscreen%=!cat%:SYS "OS_RemoveCursors"
7640CALL undorestore%
7650CASE n% OF
7660WHEN0:PROCcompressedsave(f$):PROCstore($screen_str%,f$)
7670WHEN1:OSCLI"SCREENSAVE "+f$:PROCstore($screen_str%,f$)
7680WHEN2:PROCcompactedsave(0,f$):PROCstore($screen_str%,f$)
7690WHEN3:PROCcompactedsave(1,f$):PROCstore($screen_str%,f$)
7700ENDCASE
7710PROCrestorewimp
7720WHEN4:OSCLI"SSAVE "+f$:PROCstore($sprite_str%,f$)
7730WHEN5:OSCLI"SAVE "+f$+" "+STR$~(brush%)+" +2000":PROCstore($brush_str%,f$)
7740OSCLI"SETTYPE "+f$+" D7E"
7750WHEN6:OSCLI"SAVE "+f$+" "+STR$~(brpatt%)+" +2000":PROCstore($brush_str%,f$)
7760OSCLI"SETTYPE "+f$+" D3A"
7770ENDCASE
7780ENDPROC
7790
7800DEFPROCsetfile_at(n%,RETURN f$,RETURN s%,RETURN t%)
7810REM ;{{ setup up f$ to be filename, s% to estimated size and t%
7820REM ;{{ to filetype for file of internal type n%
7830REM ;{{ NB s%<0 means unknown size, try it anyway
7840CASE n% OF
7850WHEN0:t%=&DE2:f$=$screen_str% :s%=&28000
7860WHEN1:t%=&FF9:f$=$screen_str% :s%=&28000
7870WHEN2:t%=&D7F:f$=$screen_str% :s%=-1
7880WHEN3:t%=&D7F:f$=$screen_str% :s%=-1
7890WHEN4:t%=&FF9:f$=$sprite_str% :SYS "OS_SpriteOp",8TO,,,,,s%
7900WHEN5:t%=&D7E:f$=$brush_str% :s%=&2000
7910WHEN6:t%=&D3A:f$=$pattern_str%:s%=&2000
7920ENDCASE
7930ENDPROC
7940
7950DEFPROCanimate_sprites
7960FOR frame%=0 TO 7
7970CALL colour%:RECTANGLE FILL 0,0,1023,1023
7980OSCLI"PlotFile AniCreate.Sprites.Frame"+STR$frame%
7990CALL undosave%
8000x1%=0:y1%=0
8010x2%=1023:y2%=1023
8020x3%=0:y3%=0
8030x4%=x3%+63:y4%=y3%+127
8040step%=happenstep%:PROCscreen_select
8050OSCLI"DefineBuffer "+STR$(STORE%)+" &28000"
8060OSCLI"Com_Save AniCreate.Sprites.Small"+STR$frame%+" 0 0 63 127 0"
8070NEXT
8080ENDPROC
8090
8100DEFPROCanimate
8110FOR frame%=45 TO 64
8111FOR !pc%=0 TO 255 STEP 255
8120CALL colour%:RECTANGLE FILL 0,0,1023,1023
8130OSCLI"PlotFile ShipSpr.Sprites.Ship"+STR$frame%
8140CALL undosave%
8150x1%=0:y1%=0
8160x2%=1023:y2%=1023
8170x3%=1024+!pc%DIV255*96:y3%=0
8180x4%=x3%+95:y4%=y3%+191
8190step%=happenstep%:PROCscreen_select
8191NEXT
8200OSCLI"DefineBuffer "+STR$(STORE%)+" &28000"
8210OSCLI"Com_Save ShipSpr.Small.Ship"+STR$frame%+" 1024 0 1215 191 0"
8220NEXT
8230ENDPROC
8240
8250DEFPROCatelier
8260angle=0
8270*FX 15,0
8280REM ---------MAIN LOOP-----------
8290ON ERROR LOCAL PROCerror_at
8300REPEAT
8310REPEAT
8320mrctx1%=0
8330mrcty1%=0
8340mrctx2%=1279
8350mrcty2%=1023
8360CASE !Ac% OF
8370WHEN35,36:mrctx1%=32:mrcty1%=32:mrctx2%=1216:mrcty2%=960
8380WHEN24:IF step%>2 THEN PROCsetlimits(xs%,-ys%)
8390WHEN45:mrctx1%=-xs%-xo%:mrcty1%=-ys%-yo%:mrctx2%=1280+xs%:mrcty2%=1024+ys%
8400WHEN71:IF step%>2 THEN mrctx1%=x1%:mrcty1%=y2%:mrctx2%=xs%:mrcty2%=-ys%
8410WHEN75:IF step%>2 THEN mrctx2%-=xs%DIV2:mrcty2%+=ys%
8420WHEN37,40:IF FNsprites>0 THEN CALL locatesprite%:SYS &2E,40,,!sprstr TO ,,,xs%,ys%:PROCsetlimits(xs%*2,ys%*4)
8430ENDCASE
8440MOUSE RECTANGLE mrctx1%,mrcty1%,mrctx2%,mrcty2%
8450PROCmouse_handle
8460IF MB=2 OR enter% THEN PROCmenucalled
8470AcCODE%=?(!step_codes)
8480happenstep%=(AcCODE% AND 15)
8490stepcode%=?(!step_codes+step%)
8500IF (!pm%=2) AND (stepcode% AND 64) THEN step%+=1:PROCcopysort:F%=step%:CALL helpstep%:GOTO 8490
8510CASE !Ac% OF
8520WHEN60,61,62,63,64,65
8530CASE !rect_brush_mode OF
8540WHEN0:AcCODE%=AcCODE% AND 191
8550WHEN1:happenstep%+=1:AcCODE%=AcCODE% OR 64
8560IF step%=2 THEN stepcode%=stepcode% OR 16
8570WHEN2:happenstep%+=1:AcCODE%=AcCODE% AND 191
8580IF step%=1 THEN stepcode%=stepcode% OR 16+32
8590ENDCASE
8600ENDCASE
8610IF (AcCODE% AND 64) AND step%=happenstep% THEN step%=1:PROCBUTOFF(4):F%=step%:CALL helpstep%
8620IF NOT (AcCODE% AND 64) AND step%=happenstep% THEN step%=step%-1:F%=step%:CALL helpstep%
8630CASE TRUE OF
8640WHEN(NOT (AcCODE% AND 64)) AND (step%=happenstep%-1):
8650IF (MB AND 4)=4 THEN step%=step%+1:F%=step%:CALL helpstep%
8660OTHERWISE
8670IF NOT select THEN IF (MB AND 4)=(step% AND 1)*4 THEN step%=step%+1:F%=step%:CALL helpstep%
8680IF select THEN IF (MB AND 4) THEN step%=step%+1:F%=step%:CALL helpstep%:PROCBUTOFF(4)
8690ENDCASE
8700*FX 229,1
8710IF step%=happenstep% THEN *FX 229,0
8720inaction=!Ac%
8730IF (MB AND 1)=1 THEN PROCadjustpressed
8740E%=-1
8750IF stepcode% AND 16 THEN
8760CASE step% OF
8770WHEN0,1:C%=MX-x0%:D%=MY-y0%
8780WHEN2,3:C%=MX-x1%:D%=MY-y1%
8790WHEN4,5:C%=MX-x3%:D%=MY-y3%
8800ENDCASE
8810IF stepcode% AND 32 THEN B%=C%*2:C%=D%:CALL calc_radius%:C%=!RESULTX/2:E%=2 ELSE E%=0
8820ENDIF
8830A%=MX:B%=MY:CALL help%
8840IF step%=happenstep% AND (AcCODE% AND 128) THEN
8850WAIT
8860CALL liftup%
8870CALL colour%
8880IF !pm%>0 AND (AcCODE% AND &20) THEN CALL bit_map_scan_A%
8890PROCscreen_select
8900IF !pm%>0 AND (AcCODE% AND &20) THEN CALL bit_map_pattern%
8910IF (AcCODE% AND 16) THEN CALL show_thru%
8920CALL liftdown%
8930ELSE
8940GCOL 3,63 TINT 192
8950PROCscreen_select
8960ENDIF
8970keypress%=INKEY(0):IF keypress%>0 THEN PROCkeypressed
8980IF inaction<>!Ac% THEN PROCprocess_new_action
8990IF step%<>oldstep% THEN F%=step%:CALL helpstep%
9000oldstep%=step%
9010UNTIL !Ac%=20
9020PROCreset_action
9030IF os%=1 THEN
9040IF testing THEN
9050PROCerrorhandle(3,"Where to Boss","Basic Program|Source Code|Don't Exit",selected)
9060ELSE
9070PROCerrorhandle(2,"Do you really wish to exit from ATELIER","CONFIRM",selected)
9080ENDIF
9090ELSE selected=1
9100ENDIF
9110IF testing THEN UNTIL selected=1 OR selected=2
9120IF NOT testing THEN UNTIL selected=1
9130REM -------------END OF MAIN LOOP ----------
9140IF NOT testing OR os%=2 THEN ENDPROC
9150PROCtidy_at
9160*FX 15,0
9170CASE selected OF
9180WHEN1:
9190*KEY 4 SAVE|MRUN|M
9200*FX 138,0,69
9210*FX 138,0,68
9220*FX 138,0,46
9230*FX 138,0,46
9240*FX 138,0,13
9250END
9260WHEN2:
9270*KEY 4 RUN|M
9280PROCstring_to_buffer("LO. ""<Ateli*$Dir>.Sour*.Sou*"""+CHR$(13)+"ED.."+CHR$(13))
9290END
9300ENDCASE
9310ENDPROC
9320
9330DEFPROCadjustpressed
9340IF !Ac%=82 OR !Ac%=59 THEN
9350PROCreset_action
9360ELSE
9370IF (MB AND 1)=1 AND step%>1 THEN step%=step%-1:PROCBUTOFF(1):PROCupdate:F%=step%:CALL helpstep%
9380ENDIF
9390ENDPROC
9400
9410DEFPROCreset_action
9420!Ac%=!oldaction%
9430ENDPROC
9440
9450DEFPROCmouse_handle
9460MOUSE MX,MY,MB:IF mgs THEN PROCmousegrid
9470IF !left_handed THEN CASE MB OF
9480WHEN%001:MB=%100
9490WHEN%011:MB=%110
9500WHEN%100:MB=%001
9510WHEN%110:MB=%011
9520ENDCASE
9530IF NOT INKEY(-97) THEN ENDPROC
9540IF INKEY(-1) THEN xrst%=MX:yrst%=MY ELSE MOUSE TO xrst%,yrst%
9550ENDPROC
9560
9570DEF PROCmousegrid
9580MX=((MX+mousegrid DIV 2) DIV mousegrid)*mousegrid
9590MY=((MY+mousegrid DIV 2) DIV mousegrid)*mousegrid
9600IF MX<mrctx1% THEN MX=mrctx1%
9610IF MY<mrcty1% THEN MY=mrcty1%
9620IF MX>mrctx2% THEN MX=mrctx2%
9630IF MY>mrcty2% THEN MY=mrcty2%
9640POINT TO MX,MY
9650ENDPROC
9660
9670DEFPROCset_action
9680CASE !Ac% OF
9690WHEN57,59,82,43
9700OTHERWISE
9710!oldaction%=!Ac%
9720ENDCASE
9730ENDPROC
9740
9750DEFPROCBUTOFF(M)
9760REPEAT
9770MOUSE DX,DY,MB
9780IF !left_handed THEN CASE MB OF
9790WHEN%001:MB=%100
9800WHEN%011:MB=%110
9810WHEN%100:MB=%001
9820WHEN%110:MB=%011
9830ENDCASE
9840UNTIL (MB AND M)=0
9850ENDPROC
9860
9870DEFPROCkeypressed
9880*FX 15,0
9890CASE CHR$(keypress%) OF
9900WHEN"*":enter%=5
9910ENDCASE
9920IF (keypress% AND 128)=0 THEN ENDPROC
9930CASE keypress% OF
9940WHEN&80,&90,&A0,&B0 :REM f0-print key
9950CALL liftup%
9960CALL undosave%
9970PROCpoint(0,0)
9980OSCLI(funcprint$)
9990IF MODE<>15 THEN MODE 15:CALL undorestore%
10000PROCupdate
10010CALL liftdown%
10020WHEN&B1
10030CALL undosave%
10040*FX229
10050MODE 0
10060VDU2
10070FOR !Ac%=0 TO 82
10080!rect_brush_mode=(!Ac% MOD 3)
10090PRINT"Function ";!Ac%
10100PRINT
10110CALL helptext%
10120PRINT
10130NEXT
10140VDU3
10150MODE 15
10160CALL undorestore%
10170WHEN&81,&91,&A1,&B1:CALL liftup%:CALL undorestore%:CALL liftdown%
10180WHEN&82,&92,&A2,&B2:step%=1:PROCset_action:!Ac%=57
10190WHEN&83,&93,&A3,&B3:IF !Ac%<>82 THEN step%=1:PROCset_action:!Ac%=82 ELSE !brushsel%=((!brushsel%+1) AND 15)
10200WHEN&84,&94,&A4,&B4:!pm%=0:!pc%=POINT(MX,MY)+TINT(MX,MY):PROCupdate
10210WHEN&85,&95,&A5,&B5
10220IF !helpstatus% THEN CALL helpon%:VDU5:CALL helptext%:F%=step%:CALL helpstep% ELSE CALL helpoff%
10230WHEN&86,&96,&A6,&B6
10240mgs=1-mgs:PROCupdate
10250WHEN&87,&97,&A7,&B7
10260IF testing AND keypress%=&A7 THEN
10270*FX229
10280CALL liftup%:PROCanimate:CALL liftdown%
10290ELSE
10300CALL liftup%
10310CALL undosave%
10320CALL liftdown%
10330ENDIF
10340WHEN&88,&98,&A8,&B8
10350IF (testing AND keypress%=&88) OR (NOT testing) THEN PROCset_action:!Ac%=20
10360IF testing AND keypress%=&98 THEN os%=1:!Ac%=20
10370IF testing AND keypress%=&A8 THEN CALL liftup%:A%=!presentmenu%:G%=MX:H%=MY:CALL drawmenu%:CALL liftdown%
10380ENDCASE
10390keyin%=(keypress%AND&F)-9
10400IF keyin%>4 THEN keyin%=-1
10410IF keyin%>-1 THEN
10420keylevel%=(((keypress%AND&F0)>>4)MOD4)
10430IF INKEY(-3) THEN function%(keyin%,keylevel%)=!Ac% ELSE !Ac%=function%(keyin%,keylevel%):PROCupdate
10440ENDIF
10450ENDPROC
10460
10470DEFPROCprocess_new_action
10480IF !Ac%=33 THEN PROCreset_action
10490VDU5:CALL helptext%:F%=1:CALL helpstep%:step%=1:PROCupdate
10500ENDPROC
10510
10520DEFPROCmenucalled
10530PROCset_action
10540MOUSE RECTANGLE 0,0,1279,1023
10550CALL liftup%
10560!mousebuts=0
10570IF ?(!actionsave)<255 THEN ?(!actionsave)=!Ac%
10580GCOL 128+(BACKCOL% AND 63) TINT (BACKCOL% AND 192)
10590CASE enter% OF
10600WHEN2:A%=7:CALL downtree%:REM sprites
10610WHEN5:A%=28:CALL downtree%:REM oscli
10620ENDCASE
10630IF enter%=4 AND !Ac%=12 THEN A%=9 ELSE A%=0
10640MOUSE MX,MY,MB
10650G%=MX:H%=MY:CALL menusystem%
10660IF !Ac%=33 THEN PROCreset_action
10670step%=1:PROCupdate:PROCBUTOFF(7)
10680IF !Ac%<>43 THEN
10690CALL liftdown%
10700VDU5:CALL helptext%
10710F%=step%:CALL helpstep%
10720ENDIF
10730IF ?(!actionsave)<255 THEN !oldaction%=?(!actionsave)
10740enter%=0
10750ENDPROC
10760
10770DEFPROCiniterror
10780IF MODE=15 THEN MODE 0
10790VDU 7
10800IF ERR=17 THEN PRINT"Escaped!":END
10810PRINTREPORT$;" at line ";ERL
10820IF NOT testing THEN END
10830*FX 15,0
10840A=GET
10850PROCstring_to_buffer("ED. "+STR$(ERL)+CHR$(13))
10860END
10870ENDPROC
10880
10890DEFPROCstring_to_buffer(tran$)
10900REPEAT
10910OSCLI"FX 138,0,"+STR$(ASC(LEFT$(tran$,1)))
10920tran$=MID$(tran$,2)
10930UNTIL tran$=""
10940ENDPROC
10950
10960DEFPROCtidy_at
10970PROCsetsoftkeys
10980PROCunsetvectors
10990ENDPROC
11000
11010DEFPROCunsetsoftkeys
11020FOR R=221 TO 228:OSCLI"FX "+STR$(R)+",2":NEXT
11030*FX 219,9
11040ENDPROC
11050
11060DEFPROCsetsoftkeys
11070FOR R=221 TO 228:OSCLI"FX "+STR$(R)+",1":NEXT
11080*FX 219,9
11090ENDPROC
11100
11110DEFPROCinit_at
11120IF testing THEN ON ERROR LOCAL PROCiniterror
11130RESTORE11110
11140PNglass=2:PNbrush=3:PNflood=4:PNpencil=5:PNspray=6
11150PNnormal=7:PNspriteop=8:PNcalculator=14:PNkeyboard=15:PNA=16:PNstopped=17
11160PNquestion=18:PNhand=19
11170com_gx1%=0:com_gy1%=0:com_gx2%=1278:com_gy2%=1020
11180PROCunsetsoftkeys:K=1024
11190DIM BLOW% 1*K,STORE% 160*K,cat% 1*K,brush% 8*K,brpatt% 8*K,cycle% 128,file_icons% 3*K,log_table% 256,log_scale% 1040,formnames% 1*K,fontlist% 1*K
11200DIM skel% 1764*10,sqr% &5201,sin% 360*4,tan% 90*4,numbers% &720,screen_str% 256,pattern_str% 256,brush_str% 256,sprite_str% 256,file_str% 256
11210DIM behind% 256,flags% 4,PO% &14DC,sprstr% 30,fontstr% 45,presentfont% 80,xget% 800,yget% 800,BUFF% 1*K,BUFFER% 35328,freetable% 256,abts% 16
11220DIM L(640),A%(641,1),B%(256,1),function%(4,3),formulas$(10)
11230OSCLI"LOAD "+FNdir+"POINTER "+STR$~(PO%)
11240IF os%=1 THEN PROCpoint(0,1)
11250s%=OPENIN(FNdir+"code*"):sz%=EXT#s%:CLOSE#s%
11260DIM code% sz%:OSCLI"LOAD "+FNdir+"code* "+STR$~(code%)
11270pl$="LOAD "+FNdir
11280OSCLIpl$+"!Brushes "+STR$~(brush%)
11290OSCLIpl$+"!Patterns "+STR$~(brpatt%)
11300*Com_Open <Atelier$Dir>.Sprites
11310PROCin(file_icons%,"40 8")
11320PROCin(numbers%,"12 8")
11330PROCin(BUFFER%,"384 92")
11340*Com_Close
11350PROCcodevars
11360IF os%=1 THEN PROCpoint(0,0)
11370$screen_str%="Screen"
11380$pattern_str%="Patterns"
11390$brush_str%="Brushes"
11400$sprite_str%="SpriteFile"
11410$sprstr%="new_sprite"
11420g_sprite$="new_sprite"
11430cycle%!0=16
11440FOR R=0 TO 3
11450READ o%
11460FOR R1=0 TO 3
11470!(cycle%+R*16+R1*4+4)=o%+R1
11480NEXT:NEXT
11490FOR R=0 TO 255:?(behind%+R)=255:NEXT
11500FOR R=1 TO 256:?(log_table%+R-1)=20+(R^2)/300:NEXT:FOR R=0 TO 5248:!(sqr%+R*4)=SQR(R*1024):NEXT
11510FOR R=0 TO 359:!(sin%+R*4)=SINRAD(R)*65536:NEXT
11520FOR R=0 TO 89:!(tan%+R*4)=TANRAD(R)*65536:NEXT
11530DATA 0,44,208,252
11540DATA 4,364,408,584,224,584,72,456,72
11550READ numlist
11560!bolpoint%=numlist
11570FOR R=0 TO !bolpoint%-1
11580READ X,Y
11590!(xget%+R*4)=X:!(yget%+R*4)=Y+4
11600NEXT
11610?(flags%)=255
11620?(flags%+1)=255
11630?(flags%+2)=255
11640?(flags%+3)=255
11650!sprstr=sprstr%
11660!brpatt=brpatt%
11670!flags=flags%
11680!cat=cat%
11690!behind=behind%
11700!brushshapes=brush%
11710!BUFF=BUFF%
11720!FLOB=PO%
11730!bolx=xget%
11740!boly=yget%
11750!fontstr=fontstr%
11760!presentfont=presentfont%
11770!STORE=STORE%
11780!freetable=freetable%
11790!put=BUFFER%
11800!cycle=cycle%
11810!screen_str=screen_str%
11820!pattern_str=pattern_str%
11830!brush_str=brush_str%
11840!sprite_str=sprite_str%
11850!file_icons=file_icons%
11860!log_table=log_table%
11870!log_scale=log_scale%
11880!numbers=numbers%
11890!sqr=sqr%
11900!sin=sin%
11910!tan=tan%
11920!file_str=file_str%
11930!formnames=formnames%
11940!skel=skel%
11950!fontlist=fontlist%
11960*IF "<Font$Prefix>"="" THEN *SET Font$Prefix $
11970LOCAL ERROR
11980ON ERROR LOCAL $fontlist%="Font Disk Not Present"+CHR$(0):GOTO 12010
11990A%=testing
12000CALL initialisation%
12010RESTORE ERROR
12020PROCcheckdumper
12030xrst%=640:yrst%=512
12040x0%=0:y0%=0:x1%=0:y1%=0
12050x2%=0:y2%=0:x3%=0:y3%=0
12060x4%=0:y4%=0:x5%=0:y5%=0
12070actionflags%=8:actionstep%=3
12080xs%=0:ys%=0:oldstep%=0
12090step%=1:vectors_set%=FALSE
12100wedge%=0:col%=0
12110psizex%=160:psizey%=160
12120xpsize%=-1:ypsize%=-1
12130mgs=FALSE:mcs=FALSE
12140mousegrid=32:select=TRUE
12150P%=formnames%
12160[OPT 0
12170EQUB 1
12180EQUB 10
12190EQUS "Defineable"
12200]
12210formula$="SIN(YR)*50"
12220dummy=FNbuild_formula(formula$,0)
12230botrad$="1"
12240atext$="Atelier (C) Simon Clay 1989"
12250PROCremovekeymod
12260funcprint$="BYE"
12270eval$=""
12280!oldaction%=60
12290ENDPROC
12300
12310
12320DEFPROCin(b%,s$)
12330OSCLI"Com_Sprites $ "+STR$(b%)+" "+s$
12340ENDPROC
12350
12360DEFPROCremovekeymod
12370LOCAL ERROR
12380ON ERROR LOCAL ENDPROC
12390*Unplug InternationalKeyboard
12400ENDPROC
12410
12420DEFPROCset_abort_traps
12430abts%!0=!&C
12440abts%!4=!&10
12450abts%!8=!&14
12460FOR PASS=0 TO 2 STEP 2
12470P%=&C
12480[OPT PASS
12490B abt1% ;sets abort on instuction fetch error trap
12500B abt2% ;sets abort on data transfer error trap
12510B abt3% ;sets address exception error trap
12520]NEXT
12530ENDPROC
12540
12550DEFPROCunset_abort_traps
12560!&0C=abts%!0
12570!&10=abts%!4
12580!&14=abts%!8
12590ENDPROC
12600
12610DEFPROCcodevars
12620
12630variablelocate%=code%+4*1
12640com_put%=code%+4*2
12650locatesprite%=code%+4*3
12660help%=code%+4*4
12670helpon%=code%+4*5
12680helpoff%=code%+4*6
12690helpstep%=code%+4*7
12700helptext%=code%+4*8
12710liftup%=code%+4*9
12720liftdown%=code%+4*10
12730colour%=code%+4*11
12740undorestore%=code%+4*12
12750undosave%=code%+4*13
12760drawmenu%=code%+4*14
12770menusystem%=code%+4*15
12780mousecolour%=code%+4*16
12790screen_select%=code%+4*17
12800spriteinit%=code%+4*18
12810magnify%=code%+4*19
12820uptree%=code%+4*20
12830putbackground%=code%+4*21
12840com_get%=code%+4*22
12850putscreenrectangle%=code%+4*23
12860brusheor%=code%+4*24
12870brushdraw%=code%+4*25
12880brushundo%=code%+4*26
12890spritepix%=code%+4*27
12900brushget%=code%+4*28
12910shapeget%=code%+4*29
12920spriteputerror%=code%+4*30
12930getspritefromscreen%=code%+4*31
12940priorityin%=code%+4*32
12950undochar%=code%+4*33
12960undobox%=code%+4*34
12970scanscreen%=code%+4*35
12980colourbyte%=code%+4*36
12990calc_intensity%=code%+4*37
13000splodgeread%=code%+4*38
13010setbord%=code%+4*39
13020abt1%=code%+4*40
13030FINDMENU%=code%+4*41
13040SKIPWORD%=code%+4*42
13050drawword%=code%+4*43
13060abt2%=code%+4*44
13070abt3%=code%+4*45
13080COLaverage%=code%+4*46
13090COLgcol%=code%+4*47
13100COLmode15_13resize%=code%+4*48
13110show_thru%=code%+4*49
13120swap_pixels%=code%+4*50
13130COLsmooth_rectangle%=code%+4*51
13140compactedsave%=code%+4*52
13150screensave%=code%+4*53
13160bit_map_scan_A%=code%+4*54
13170bit_map_scan_B%=code%+4*55
13180bit_map_pattern%=code%+4*56
13190vertical_fill%=code%+4*57
13200copy_fill%=code%+4*58
13210calc_radius%=code%+4*59
13220framedraw%=code%+4*60
13230spin_bottle%=code%+4*61
13240translate_point%=code%+4*62
13250anti_aliased_squash%=code%+4*63
13260screenload%=code%+4*64
13270initialisation%=code%+4*65
13280formframedraw%=code%+4*66
13290form_translate%=code%+4*67
13300convertmode%=code%+4*68
13310bytecolour%=code%+4*69
13320downtree%=code%+4*70
13330checksprites%=code%+4*71
13340compactedload%=code%+4*72
13350savecheck%=code%+4*73
13360fontlistinit%=code%+4*74
13370duff_call%=code%+4*75
13380draw_error_box%=code%+4*76
13390com_update_info%=code%+4*77
13400
13410CALLvariablelocate%
13420
13430c=!code%
13440
13450Ac%=c+4*0
13460printmenu%=c+4*1
13470pc%=c+4*2
13480brushsel%=c+4*3
13490helpstatus%=c+4*4
13500presentmenu%=c+4*5
13510bolpoint%=c+4*6
13520topscreen%=c+4*7
13530blowcol%=c+4*8
13540YES%=c+4*9
13550putit%=c+4*10
13560sprsel%=c+4*11
13570startx%=c+4*12
13580starty%=c+4*13
13590compaction%=c+4*14
13600sprpos=c+4*15
13610freecol=c+4*16
13620OUT=c+4*17
13630limtop=c+4*18
13640limbot=c+4*19
13650start=c+4*20
13660hlength=c+4*21
13670RESULTX=c+4*22
13680RESULTY=c+4*23
13690lastmenu=c+4*24
13700r1store=c+4*25
13710r0store=c+4*26
13720left_handed=c+4*27
13730compact3x4=c+4*28
13740inlaysed=c+4*29
13750sprstr=c+4*30
13760brpatt=c+4*31
13770flags=c+4*32
13780cat=c+4*33
13790behind=c+4*34
13800brushshapes=c+4*35
13810BUFF=c+4*36
13820FLOB=c+4*37
13830bolx=c+4*38
13840boly=c+4*39
13850fontstr=c+4*40
13860presentfont=c+4*41
13870STORE=c+4*42
13880freetable=c+4*43
13890put=c+4*44
13900cycle=c+4*45
13910rect_brush=c+4*46
13920screen_str=c+4*47
13930pattern_str=c+4*48
13940brush_str=c+4*49
13950sprite_str=c+4*50
13960help_text_data=c+4*51
13970file_icons=c+4*52
13980bit_map=c+4*53
13990fillstylepic=c+4*54
14000log_table=c+4*55
14010log_scale=c+4*56
14020
14030numbers=c+4*58
14040magnify_xpos=c+4*59
14050magnify_ypos=c+4*60
14060putpos=c+4*61
14070magputpos=c+4*62
14080sizex=c+4*63
14090sizey=c+4*64
14100sprsize=c+4*65
14110spritex=c+4*66
14120spritey=c+4*67
14130gtspritex=c+4*68
14140gtspritey=c+4*69
14150diskfontlistposition=c+4*70
14160catpos=c+4*71
14170fontsel=c+4*72
14180pattsel=c+4*73
14190treepos=c+4*74
14200matrixput=c+4*75
14210barval_red=c+4*76
14220barval_grn=c+4*77
14230barval_blu=c+4*78
14240scaleval_left=c+4*79
14250scaleval_right=c+4*80
14260cycleplace=c+4*81
14270cycledirection=c+4*82
14280cyclemode=c+4*83
14290pm%=c+4*84
14300mixval_red=c+4*85
14310mixval_grn=c+4*86
14320mixval_blu=c+4*87
14330mousex=c+4*88
14340mousey=c+4*89
14350mousebuts=c+4*90
14360magnification=c+4*91
14370magnify_xget=c+4*92
14380magnify_yget=c+4*93
14390magnify_status=c+4*94
14400HANG=c+4*95
14410rect_brush_mode=c+4*96
14420vacant=c+4*97
14430com_x1=c+4*98
14440com_y1=c+4*99
14450com_x2=c+4*100
14460com_y2=c+4*101
14470sprint_xsize=c+4*102
14480sprint_ysize=c+4*103
14490spritemask=c+4*104
14500fill_style=c+4*105
14510fill_prop=c+4*106
14520fill_logr=c+4*107
14530fill_dith=c+4*108
14540step_codes=c+4*109
14550border=c+4*110
14560sqr=c+4*111
14570actionsave=c+4*112
14580bottle=c+4*113
14590bot_tilt=c+4*114
14600bot_lean=c+4*115
14610bot_xout=c+4*116
14620bot_yout=c+4*117
14630line_selected=c+4*118
14640bot_finish=c+4*119
14650bot_xscale=c+4*120
14660bot_yscale=c+4*121
14670hangdelay=c+4*122
14680sin=c+4*123
14690tan=c+4*124
14700file_str=c+4*125
14710form=c+4*126
14720tilt=c+4*127
14730lean=c+4*128
14740rotation=c+4*129
14750xscale=c+4*130
14760yscale=c+4*131
14770hscale=c+4*132
14780form_list_pos=c+4*133
14790formnames=c+4*134
14800formula=c+4*135
14810skel=c+4*136
14820shade_range=c+4*137
14830min_shade=c+4*138
14840fontlist=c+4*139
14850oldaction%=c+4*140
14860
14870
14880BORDSIZE=28
14890WEDGESIZE=16
14900textcol%=0
14910BACKCOL%=202
14920TITLECOL%=0
14930BORDERCOL%=74
14940BORD1%=207
14950BORD2%=15
14960BORD3%=138
14970BORD4%=197
14980DIRECTORYCOL%=224
14990
15000ENDPROC
15010
15020DEFPROCscreen_select
15030
15040IF (!Ac%=1 OR !Ac%=2) AND step%=3 THEN
15050REPEAT
15060PROCmouse_handle
15070D%=!Ac%:E%=step%:F%=MB:G%=MX:H%=MY:CALL screen_select%
15080UNTIL MB=0
15090IF !Ac%=1 THEN x1%=MX:y1%=MY
15100ELSE
15110D%=!Ac%:E%=step%:F%=MB:G%=MX:H%=MY:CALL screen_select%
15120ENDIF
15130IF !YES% THEN
15140CASE step% OF
15150WHEN1:x1%=MX:y1%=MY
15160WHEN2:x2%=MX:y2%=MY
15170WHEN3:x3%=MX:y3%=MY
15180WHEN4:x4%=MX:y4%=MY
15190WHEN5:x5%=MX:y5%=MY
15200ENDCASE
15210ENDIF
15220IF !YES% THEN ENDPROC
15230
15240
15250CASE (!Ac%) OF
15260
15270REM Magnify
15280WHEN12:CASE step% OF
15290WHEN2:enter%=4
15300!magnify_xpos=MX DIV 2
15310!magnify_ypos=255-(MY DIV 4)
15320ENDCASE
15330
15340REM Fill
15350WHEN13:CASE step% OF
15360WHEN2:PROCpoint(0,0)
15370col%=POINT(MX,MY)+TINT(MX,MY)
15380GCOL 128+POINT(MX,MY) TINT TINT(MX,MY)
15390CASE !fill_style OF
15400WHEN0:
15410IF !pm%>0 THEN CALL bit_map_scan_A%
15420IF !pm%>0 OR col%<>!pc% THEN PLOT&85,MX,MY
15430IF !pm%>0 THEN CALL bit_map_pattern%
15440WHEN1,2,3:
15450CALL bit_map_scan_A%
15460PLOT&85,MX,MY
15470CASE !fill_style OF
15480WHEN1,2:CALL vertical_fill%
15490WHEN3:A%=MX DIV2:B%=255-MY DIV4
15500CALL vertical_fill%
15510ENDCASE
15520ENDCASE
15530PROCupdate
15540ENDCASE
15550
15560REM Sprite Handling
15570WHEN14,16
15580GCOL 0,(textcol% AND 63) TINT (textcol% AND 192)
15590GCOL 0,128+(BACKCOL% AND 63) TINT (BACKCOL% AND 192)
15600SYS &2E,8 TO ,,,r3
15610SYS &2E,13,,sprstr%,30,!sprsel% TO ,,,leng
15620?(sprstr%+leng+1)=13
15630errorcheat=!Ac%
15640!putit%=1:PROCpoint(0,PNkeyboard)
15650PROCreset_action:CALL uptree%
15660A%=-128:B%=!starty%+56:E%=-1:CALL help%
15670A%=-128:B%=!starty%-!sizey-96:E%=-1:CALL help%
15680XP=!startx%+6:YP=!starty%-48:MOVE XP,YP:VDU 5:PRINT" ";
15690step%=1:PRINT$sprstr%:!starty%=!starty%-32
15700old$=$sprstr%:old$=LEFT$(old$,LEN(old$)-1)
15710go=FNinstring(33,126,"",out$,12)
15720CALL liftup%:CALL putbackground%
15730IF go THEN
15740CASE errorcheat OF
15750WHEN16:OSCLI "SCOPY "+old$+" "+out$:!sprsel%=r3+1:!sprpos=r3-5
15760WHEN14:OSCLI "SRENAME "+old$+" "+out$
15770ENDCASE
15780ENDIF
15790PROCreset_entry
15800
15810REM Save Compressed Screen
15820WHEN15:IF FNtext_entry(33,$screen_str%,255) THEN
15830PROCpoint(0,1):PROCcompressedsave(out$):$screen_str%=out$
15840ENDIF
15850PROCreset_entry
15860
15870REM Save Brushes
15880WHEN17:IF FNtext_entry(33,$brush_str%,255) THEN
15890PROCpoint(0,1):OSCLI "SAVE "+out$+" "+STR$~(brush%)+" +2000"
15900OSCLI("SETTYPE "+out$+" &D7E"):$brush_str%=out$
15910ENDIF
15920PROCreset_entry
15930
15940REM Name Sprite
15950WHEN18:IF FNtext_entry(33,g_sprite$,12) THEN g_sprite$=out$
15960!Ac%=38:PROCreset_entry
15970
15980REM Save Patterns
15990WHEN19:IF FNtext_entry(33,$pattern_str%,255) THEN
16000PROCpoint(0,1):OSCLI "SAVE "+out$+" "+STR$~(brpatt%)+" +2000"
16010OSCLI("SETTYPE "+out$+" &D3A"):$pattern_str%=out$
16020ENDIF
16030PROCreset_entry
16040
16050REM function 20 -- FINISH -- !
16060
16070REM Set Border Colour
16080WHEN21:PROCreset_action
16090CALL setbord%
16100
16110REM Ellipse
16120WHEN22:CASE step% OF
16130WHEN1:x1%=MX:y1%=MY
16140WHEN2:rd%=SQR((MX-x1%)^2+(MY-y1%)^2)
16150CIRCLE x1%,y1%,rd%
16160WAIT:WAIT:CIRCLE x1%,y1%,rd%
16170WHEN3:MOVE x1%,y1%:MOVE x1%+rd%,y1%:PLOT &C5,MX,MY
16180WAIT:WAIT:MOVE x1%,y1%:MOVE x1%+rd%,y1%:PLOT &C5,MX,MY
16190WHEN4:MOVE x1%,y1%:MOVE x1%+rd%,y1%:PLOT &C5,MX,MY
16200ENDCASE
16210
16220REM EllipseFill
16230WHEN23:CASE step% OF
16240WHEN1:x1%=MX:y1%=MY
16250WHEN2:rd%=SQR((MX-x1%)^2+(MY-y1%)^2)
16260CIRCLE x1%,y1%,rd%
16270WAIT:WAIT:CIRCLE x1%,y1%,rd%
16280WHEN3:MOVE x1%,y1%:MOVE x1%+rd%,y1%:PLOT &C5,MX,MY
16290WAIT:WAIT:MOVE x1%,y1%:MOVE x1%+rd%,y1%:PLOT &C5,MX,MY
16300WHEN4:MOVE x1%,y1%:MOVE x1%+rd%,y1%:PLOT &CD,MX,MY
16310ENDCASE
16320
16330REM fastcopy
16340WHEN24:CASE step% OF
16350WHEN1,2:PROCgetrectangle
16360WHEN3:MX=(MX DIV 2)*2:MY=(MY DIV 4)*4:PROCcopysort
16370RECTANGLE MX,MY,xs%-2,-(ys%+4)
16380WAIT:WAIT:RECTANGLE MX,MY,xs%-2,-(ys%+4)
16390WHEN4:
16400A%=x1%DIV2
16410B%=255-(y1%DIV4)
16420C%=xs%DIV2
16430D%=-ys%DIV4
16440E%=MX DIV2
16450F%=255-(MY DIV4)+(ys%+4)DIV4
16460G%=!pm%
16470CALL putscreenrectangle%
16480ENDCASE
16490
16500REM smearcopy
16510WHEN25:CASE step% OF
16520WHEN1,2:PROCgetrectangle
16530WHEN3:px1%=MX:py1%=MY
16540WHEN4:LINE px1%,py1%,MX,MY
16550WAIT:WAIT:LINE px1%,py1%,MX,MY
16560px2%=MX:py2%=MY
16570WHEN5:LINE px1%,py1%,px2%,py2%:DRAW MX,MY:DRAW px1%,py1%
16580WAIT:WAIT:LINE px1%,py1%,px2%,py2%:DRAW MX,MY:DRAW px1%,py1%
16590px3%=MX:py3%=MY
16600WHEN6:LINE px1%,py1%,px2%,py2%:DRAW px3%,py3%:DRAW MX,MY:DRAW px1%,py1%
16610WAIT:WAIT:LINE px1%,py1%,px2%,py2%:DRAW px3%,py3%:DRAW MX,MY:DRAW px1%,py1%
16620px4%=MX:py4%=MY
16630WHEN7:
16640PROCsmearscreen(x1%,y1%,xs%,ys%)
16650ENDCASE
16660
16670REM Parrallogram
16680WHEN26:CASE step% OF
16690WHEN1:px1%=MX:py1%=MY
16700WHEN2:LINE px1%,py1%,MX,MY
16710WAIT:WAIT:LINE px1%,py1%,MX,MY
16720px2%=MX:py2%=MY
16730WHEN3:LINE px1%,py1%,px2%,py2%:DRAW MX,MY:DRAW px1%-(px2%-MX),py1%-(py2%-MY):DRAW px1%,py1%
16740WAIT:WAIT:LINE px1%,py1%,px2%,py2%:DRAW MX,MY:DRAW px1%-(px2%-MX),py1%-(py2%-MY):DRAW px1%,py1%
16750WHEN4:LINE px1%,py1%,px2%,py2%:DRAW MX,MY:DRAW px1%-(px2%-MX),py1%-(py2%-MY):DRAW px1%,py1%
16760ENDCASE
16770
16780REM Parralogram fill
16790WHEN27:CASE step% OF
16800WHEN1:px1%=MX:py1%=MY
16810WHEN2:LINE px1%,py1%,MX,MY
16820WAIT:WAIT:LINE px1%,py1%,MX,MY
16830px2%=MX:py2%=MY
16840WHEN3:LINE px1%,py1%,px2%,py2%:DRAW MX,MY:DRAW px1%-(px2%-MX),py1%-(py2%-MY):DRAW px1%,py1%
16850WAIT:WAIT:LINE px1%,py1%,px2%,py2%:DRAW MX,MY:DRAW px1%-(px2%-MX),py1%-(py2%-MY):DRAW px1%,py1%
16860WHEN4:MOVE px1%,py1%:MOVE px2%,py2%:PLOT &75,MX,MY
16870ENDCASE
16880
16890REM Cls
16900WHEN28:
16910PROCerrorhandle(2,"Do you really wish to clear the screen to the current colour (NOTE You can UNDO afterwards)","CONFIRM",selected)
16920IF selected=1 THEN
16930CALL liftup%
16940CALL colour%:RECTANGLE FILL 0,0,1279,1023
16950CALL liftdown%
16960ENDIF
16970PROCreset_action
16980PROCupdate
16990
17000REM Filing (Believe it or not!)
17010WHEN29,30,31,32
17020PROCpoint(0,1)
17030errorcheat=!Ac%:filename$=$file_str%
17040PROCreset_action:CALL uptree%
17050CASE errorcheat OF
17060WHEN29:OSCLI "SLOAD "+filename$:$sprite_str%=filename$:!pm%=2
17070WHEN30:OSCLI "SMERGE "+filename$:$sprite_str%=filename$:!pm%=2
17080WHEN31
17090CALL liftup%:CALL undosave%
17100$screen_str%=filename$
17110CASE os% OF
17120WHEN1:B%=file_str%:CALL screenload%
17130OTHERWISE:OSCLI "SCREENLOAD "+$file_str%
17140ENDCASE
17150IF MODE<>15 THEN
17160SYS "OS_RemoveCursors"
17170CASE INKEY$(0) OF
17180WHEN"D","d"
17190FOR R=0 TO 15:COLOUR R,R<<4,R<<4,R<<4:NEXT
17200WHEN"I","i"
17210FOR R=0 TO 15:COLOUR 15-R,R<<4,R<<4,R<<4:NEXT
17220ENDCASE
17230LOCAL ERROR:err%=FALSE
17240ON ERROR LOCAL err%=TRUE:GOTO 17270
17250CALL convertmode%
17260$screen_str%=filename$
17270MODE15
17280RESTORE ERROR
17290cat%!0=148
17300cat%!4=-1
17310SYS "OS_ReadVduVariables",cat%,cat%
17320!topscreen%=!cat%
17330SYS "OS_RemoveCursors"
17340CALL undorestore%
17350IF err% THEN ERROR ERR,REPORT$
17360ENDIF
17370CALL liftdown%
17380WHEN32:PROCformula_load(filename$)
17390ENDCASE
17400PROCupdate
17410
17420REM Function 33 = dummy
17430
17440REM Eval Expression
17450WHEN34:!putit%=1:PROCpoint(0,PNkeyboard)
17460PROCreset_action:CALL uptree%
17470A%=-128:B%=!starty%+56:E%=-1:CALL help%
17480A%=-128:B%=!starty%-!sizey-96:E%=-1:CALL help%
17490step%=1
17500REPEAT
17510dummy=FNinstring(32,126,eval$,out$,255):IF dummy THEN
17520!starty%-=32:PROCBUTOFF(7):eval$=out$
17530PROCeval_error_cheat:dummy=FNinstring(32,126,t$,t$,1)
17540ENDIF
17550!starty%+=32:PROCBUTOFF(7)
17560UNTIL NOT dummy
17570CALL liftup%:CALL putbackground%
17580PROCreset_entry
17590
17600REM Pattern & Brush get
17610WHEN35,36:CASE step% OF
17620WHEN1:RECTANGLE MX-32,MY-32,62,60
17630WAIT:WAIT:RECTANGLE MX-32,MY-32,62,60
17640WHEN2:A%=(MX DIV 2)-16:B%=255-((MY DIV 4)+7)
17650CASE !Ac% OF
17660WHEN35:CALL brushget%
17670WHEN36:CALL shapeget%
17680ENDCASE
17690ENDCASE
17700
17710REM Sprite put
17720WHEN37:IF FNput_check THEN
17730CASE step% OF
17740WHEN1:MX=(MX DIV 2)*2:MY=(MY DIV 4)*4:PROCspritesort
17750RECTANGLE MX,MY,xs%-2,-(ys%+4)
17760WAIT:WAIT:RECTANGLE MX,MY,xs%-2,-(ys%+4)
17770WHEN2:PROCspritesort
17780A%=x1%DIV2
17790B%=255-(y1%DIV4)
17800C%=xs%DIV2
17810D%=-ys%DIV4
17820E%=MX DIV2
17830F%=255-(MY DIV4)+(ys%+4)DIV4
17840G%=2
17850CALL putscreenrectangle%
17860ENDCASE
17870ENDIF
17880
17890REM Get Sprite
17900WHEN38:CASE step% OF
17910WHEN1,2:PROCgetrectangle
17920WHEN3:PROCsortcord
17930A%=x1%:B%=y1%:C%=x2%:D%=y2%
17940PROCpoint(0,0)
17950$sprstr%=g_sprite$
17960CALL getspritefromscreen%
17970PROCupdate
17980ENDCASE
17990
18000REM Save Sprites
18010WHEN39:IF FNtext_entry(33,$sprite_str%,255) THEN
18020PROCpoint(0,1):OSCLI "SSAVE "+out$:$sprite_str%=out$
18030ENDIF
18040PROCreset_entry
18050
18060REM Sprite smear
18070WHEN40:IF FNput_check THEN
18080CASE step% OF
18090WHEN1:MX=(MX DIV 2)*2:MY=(MY DIV 4)*4:PROCspritesort
18100RECTANGLE MX,MY,xs%-2,-(ys%+4)
18110WAIT:WAIT:RECTANGLE MX,MY,xs%-2,-(ys%+4)
18120WHEN2:PROCspritesort
18130OSCLI "SCHOOSE "+$sprstr%
18140GCOL 8,0
18150REPEAT
18160PROCmouse_handle
18170PLOT &ED,MX,MY
18180UNTIL MB=0
18190ENDCASE
18200ENDIF
18210
18220REM Printer Dumps
18230WHEN41
18240PROCreset_action
18250*FX 229
18260CALL liftup%
18270A$="SCREENDUMP 0 "+STR$~(!line_selected-1)
18280OSCLI A$
18290CALL liftdown%
18300PROCupdate
18310
18320REM Delete Sprite
18330WHEN42
18340IF FNsprites THEN
18350SYS &2E,13,,sprstr%,30,!sprsel% TO ,,,leng
18360?(sprstr%+leng+1)=13
18370PROCerrorhandle(2,"Do you really wish to delete the sprite "+$sprstr%,"Confirm",selected)
18380IF selected=1 THEN
18390OSCLI"SDELETE "+$sprstr%
18400IF !sprsel%>FNsprites THEN !sprsel%=FNsprites
18410IF !sprsel%<1 THEN !sprsel%=1
18420ENDIF
18430ELSE
18440VDU 7
18450ENDIF
18460PROCreset_action:PROCupdate
18470
18480REM oscli
18490WHEN43:
18500PROCoscliaction
18510PROCcheckdumper
18520
18530REM Anti aliased text to screen
18540WHEN44:CASE step% OF
18550WHEN1:PROCgetrectangle
18560WHEN2:PROCgetrectangle
18570WHEN3:PROCsortcord
18580tint%=((!pc% AND 192) >> 2)
18590red%=tint%+((!pc% AND 3) << 6)
18600grn%=tint%+((!pc% AND 12) << 4)
18610blu%=tint%+((!pc% AND 48) << 2)
18620tint2%=TINT(MX,MY) >> 2
18630back%=POINT(MX,MY)
18640red2%=tint2%+((back% AND 3) << 6)
18650grn2%=tint2%+((back% AND 12) << 4)
18660blu2%=tint2%+((back% AND 48) << 2)
18670FONT$=$presentfont%+CHR$(13)
18680VDU 23,25,&FF,15,red2%,grn2%,blu2%,red%,grn%,blu%
18690SYS "Font_FindFont",,FONT$,320,320,0,0 TO roman% :REM ;scrapsizes
18700SYS "Font_StringBBox",,atext$ TO ,xmin%,ymin%,xmax%,ymax%
18710xsize%=ABS(xmax%-xmin%):ysize%=ABS(ymax%-ymin%)
18720SYS "Font_ReadScaleFactor" TO ,xscale%,yscale%
18730psizex%=(x2%-x1%)*320/(xsize%/xscale%)
18740psizey%=(y1%-y2%)*320/(ysize%/yscale%)
18750xo%=(xmin%/xscale%)*psizex%/320
18760yo%=(ymin%/yscale%)*psizey%/320
18770SYS "Font_FindFont",,FONT$,psizex%,psizey%,0,0 TO roman%
18780SYS "Font_Paint",,atext$,%10000,x1%-xo%,y2%-yo%
18790COLOUR 63 TINT 192
18800ENDCASE
18810
18820REM Anti box text to screen
18830WHEN45:CASE step% OF
18840WHEN1:
18850FONT$=$presentfont%+CHR$(13)
18860SYS "Font_FindFont",,FONT$,320,320,0,0 TO roman% :REM ;scrapsizes
18870SYS "Font_StringBBox",,atext$ TO ,xmin%,ymin%,xmax%,ymax%
18880xsize%=ABS(xmax%-xmin%):ysize%=ABS(ymax%-ymin%)
18890SYS "Font_ReadScaleFactor" TO ,xscale%,yscale%
18900xs%=(xsize%/xscale%)*psizex%/320
18910ys%=(ysize%/yscale%)*psizey%/320
18920xo%=(xmin%/xscale%)*psizex%/320
18930yo%=(ymin%/yscale%)*psizey%/320
18940RECTANGLE MX+xo%,MY+yo%,xs%,ys%
18950WAIT:WAIT
18960RECTANGLE MX+xo%,MY+yo%,xs%,ys%
18970WHEN2:
18980tint%=((!pc% AND 192) >> 2)
18990red%=tint%+((!pc% AND 3) << 6)
19000grn%=tint%+((!pc% AND 12) << 4)
19010blu%=tint%+((!pc% AND 48) << 2)
19020tint2%=TINT(MX,MY) >> 2
19030back%=POINT(MX,MY)
19040red2%=tint2%+((back% AND 3) << 6)
19050grn2%=tint2%+((back% AND 12) << 4)
19060blu2%=tint2%+((back% AND 48) << 2)
19070VDU 23,25,&FF,15,red2%,grn2%,blu2%,red%,grn%,blu%
19080SYS "Font_FindFont",,FONT$,psizex%,psizey%,0,0 TO roman%
19090SYS "Font_Paint",,atext$,%10000,MX,MY
19100COLOUR 63 TINT 192
19110ENDCASE
19120
19130REM demo function
19140WHEN46
19150PROCreset_action
19160PROCerrorhandle(1,"This is a demonstration version of ATELIER so this function has been disabled,|CALL 0392 437756 to order a proper version of ATELIER, the ultimate art package.","||Continue",selected)
19170
19180REM Bottle draw
19190WHEN47:CASE step% OF
19200WHEN1,2:PROCgetrectangle
19210WHEN3
19220VDU 29,MX;MY;
19230F%=-1:CALL framedraw%
19240WAIT:WAIT
19250VDU 29,MX;MY;
19260F%=-1:CALL framedraw%
19270CALL spin_bottle%
19280WHEN4:PROCpoint(0,0)
19290PROCcopysort
19300steps%=ABS(ys%)/4-1
19310PT%=(!bolpoint%)-1
19320TL=0:FOR R%=1 TO PT%
19330L(R%)=SQR(((FNboltx(R%)-FNboltx(R%-1))^2+(FNbolty(R%)-FNbolty(R%-1))^2))
19340TL=TL+L(R%)
19350NEXT R%
19360TLP=TL/(steps%-1)
19370TLP=(TL+TLP-1)/(steps%)
19380FOR YP%=0 TO steps%
19390FL=YP%*TLP:GP%=0:FLB=0
19400IF FL<TL THEN
19410REPEAT
19420FLB=FLB+L(GP%)
19430GP%=GP%+1
19440UNTIL FLB>FL
19450ELSE
19460GP%=PT%-1
19470ENDIF
19480GP%=GP%-1
19490IF GP%>PT% THEN GP%=PT%-1
19500IF GP%<1 THEN GP%=1
19510LL=FLB-L(GP%)
19520PL=FL-LL
19530PM=PL/L(GP%)
19540B%(YP%,0)=(((FNboltx(GP%))-(FNboltx(GP%-1)))*PM)+(FNboltx(GP%-1))
19550B%(YP%,1)=((FNbolty(GP%)-FNbolty(GP%-1))*PM)+FNbolty(GP%-1)
19560NEXT YP%
19570PT%=ABS(y1%-y2%)
19580ST%=ABS(xs%)
19590STCM=360/ST%
19600SB%=0
19610T1%=0:T2%=steps%-1:TS%=1:y1%+=1
19620IF !bot_lean<=90 THEN T1%=steps%-1:T2%=0:TS%=-1:y1%-=2
19630IF !bot_lean>270 THEN T1%=steps%-1:T2%=0:TS%=-1:y1%-=2
19640FOR BT%=T1% TO T2% STEP TS%
19650wedge%=0
19660X%=B%(BT%,0):Y%=B%(BT%,1)
19670SC%=0
19680CT%=-1
19690IF !bot_lean<=180 THEN
19700deg1=-STCM:deg2=360:degs=STCM
19710ELSE
19720deg1=359+STCM:deg2=0:degs=-STCM
19730ENDIF
19740FOR Cd=deg1 TO deg2 STEP degs*2
19750CT%=CT%+1
19760VDU 26
19770CASE !pm% OF
19780WHEN0,1:plt%=FNgcol(x2%-(Cd+1)/STCM+2,y1%-BT%*4+4)
19790WHEN2:plt%=FNgcol(x2%-Cd/STCM-1,y1%-BT%*4)
19800ENDCASE
19810angle=Cd
19820A%=632-((632-X%)*EVAL(botrad$)):B%=Y%:C%=Cd:CALL translate_point%
19830XD%=!bot_xout:YD%=!bot_yout
19840VDU 29,MX;MY; :REM origin
19850IF SB%>0 AND SC%>0 AND plt% THEN
19860MOVE LXD2%,LYD2%
19870MOVE LXD%,LYD%:PLOT &55,XD%,YD%
19880PLOT&55,A%(CT%,0),A%(CT%,1)
19890ENDIF
19900SC%=1
19910LXD%=A%(CT%,0):LYD%=A%(CT%,1)
19920LXD2%=XD%:LYD2%=YD%
19930A%(CT%,0)=XD%:A%(CT%,1)=YD%
19940NEXT Cd
19950REM UNTIL C%*STCM>360
19960SB%=1
19970NEXT BT%
19980PROCupdate
19990VDU 26
20000ENDCASE
20010
20020REM Set Mouse Grid
20030WHEN48:IF FNtext_entry(33,STR$(mousegrid),15)
20040mousegrid=EVAL(out$)
20050IF mousegrid<1 THEN mousegrid=1
20060mgs=1
20070ENDIF
20080PROCreset_entry
20090
20100REM Formula Entry
20110WHEN49:oldform$=formula$:test=FALSE
20120!putit%=1:PROCpoint(0,PNkeyboard)
20130PROCreset_action:CALL uptree%
20140A%=-128:B%=!starty%+56:E%=-1:CALL help%
20150A%=-128:B%=!starty%-!sizey-96:E%=-1:CALL help%
20160REPEAT
20170go=FNinstring(32,126,formula$,formula$,255)
20180P%=formnames%
20190num%=?P%:P%+=1
20200F=0
20210test$=""
20220num2%=?P%:P%+=1
20230FOR R=1 TO num2%
20240test$=test$+CHR$(?P%)
20250P%+=1:NEXT
20260IF formula$=test$ THEN formula$=formulas$(F-1):GOTO 20170
20270F+=1
20280IF F<num% THEN GOTO 20210
20290IF go THEN PROCpoint(0,0):test=FNbuild_formula(formula$,0)
20300UNTIL test OR NOT go
20310IF NOT go THEN formula$=oldform$
20320!formula=0
20330CALL liftup%:CALL putbackground%
20340PROCreset_entry
20350
20360WHEN50,54,53:CASE step% OF
20370REM FORMULA COPY
20380WHEN1,2:PROCgetrectangle
20390WHEN3:
20400VDU 29,MX;MY;
20410F%=-1:CALL formframedraw%
20420WAIT:WAIT
20430VDU 29,MX;MY;
20440F%=-1:CALL formframedraw%
20450WHEN4:PROCcopysort
20460xsteps=720/(xs%/2):ysteps=720/(ys%/4)
20470IF !Ac%=53 THEN
20480PROCpoint(0,PNcalculator)
20490max=-65536
20500min=65536
20510ofm=0
20520FOR XD=-360 TO 360 STEP xsteps
20530wedge%=0
20540FOR YD=360 TO -360 STEP ysteps
20550XR=RAD(XD)
20560YR=RAD(YD)
20570IF !formula=0 THEN FM=EVAL(formula$) ELSE FM=EVAL(formulas$(!formula-1))
20580FD=ofm-FM
20590IF YD<360 THEN IF FD>max THEN max=FD
20600IF YD<360 THEN IF FD<min THEN min=FD
20610ofm=FM
20620NEXT YD,XD
20630ENDIF
20640YF%=0
20650PROCpoint(0,0)
20660FOR YD=360 TO -360 STEP ysteps
20670wedge%=0
20680FOR XD=-360 TO 360 STEP xsteps
20690XR=RAD(XD)
20700YR=RAD(YD)
20710IF !formula=0 THEN FM=EVAL(formula$) ELSE FM=EVAL(formulas$(!formula-1))
20720A%=XD:B%=YD:C%=FM:CALL form_translate%
20730npx%=!bot_xout
20740npy%=!bot_yout
20750PX%=((360+XD)/xsteps):PY%=((360+YD)/-ysteps)
20760VDU 4
20770VDU 26
20780xp%=x1%+PX%*2-2:yp%=y2%+PY%*4+3
20790plt%=FNgcol(xp%,yp%)
20800IF XD>-360 AND YD<360 AND plt% THEN
20810IF !Ac%=53 THEN
20820num%=4+(((L(PX%)-FM)-min)/((max-min)/11))
20830IF num%<4 THEN num%=4:IF testing THEN VDU 7
20840IF num%>15 THEN num%=15:IF testing THEN VDU 7
20850A%=col%:B%=15-num%:CALL calc_intensity%
20860ENDIF
20870VDU 29,MX;MY;
20880MOVE nlpx%,nlpy%
20890MOVE A%((ABS(PX%))-1,0),A%((ABS(PX%))-1,1)
20900PLOT &55,A%(ABS(PX%),0),A%(ABS(PX%),1)
20910PLOT &55,npx%,npy%
20920IF !Ac%=54 THEN
20930CALL colour%
20940MOVE nlpx%,nlpy%
20950DRAW A%((ABS(PX%))-1,0),A%((ABS(PX%))-1,1)
20960DRAW npx%,npy%
20970DRAW A%(ABS(PX%),0),A%(ABS(PX%),1)
20980DRAW nlpx%,nlpy%
20990ENDIF
21000ENDIF
21010L(PX%)=FM
21020nlpx%=A%(ABS(PX%),0)
21030nlpy%=A%(ABS(PX%),1)
21040A%(ABS(PX%),0)=npx%
21050A%(ABS(PX%),1)=npy%
21060ENDIF
21070NEXT XD
21080YF%=1
21090NEXT YD
21100PROCupdate
21110VDU 26
21120ENDCASE
21130
21140REM Rotate copy
21150WHEN51:CASE step% OF
21160WHEN1,2:PROCgetrectangle
21170WHEN3:x3%=MX:y3%=MY
21180WHEN4:PROCshape
21190WAIT:WAIT:PROCshape
21200WHEN5:PROCsmearscreen(x1%,y1%,xs%,ys%)
21210ENDCASE
21220
21230REM AA text input
21240WHEN52:IF FNtext_entry(32,atext$,255) THEN atext$=out$
21250PROCreset_entry
21260
21270REM Save Compacted Screen
21280WHEN55:IF FNtext_entry(33,$screen_str%,255) THEN
21290PROCpoint(0,1):PROCcompactedsave(0,out$):$screen_str%=out$
21300ENDIF
21310PROCreset_entry
21320
21330REM Set Print Key Command
21340WHEN56:IF FNtext_entry(32,funcprint$,255) THEN funcprint$=out$
21350PROCreset_entry
21360
21370REM undo box
21380WHEN57:CASE step% OF
21390WHEN1,2:PROCgetrectangle
21400WHEN3:PROCsortcord
21410A%=x1%:B%=y1%:C%=xs%:D%=-ys%
21420CALL undobox%
21430ENDIF
21440step%=1:PROCreset_action:PROCupdate
21450ENDCASE
21460
21470REM Save System Screen
21480WHEN58:IF FNtext_entry(33,$screen_str%,255) THEN
21490PROCpoint(0,1):OSCLI "SCREENSAVE "+out$:$screen_str%=out$
21500ENDIF
21510PROCreset_entry
21520
21530REM Title Screen
21540WHEN59:CASE step% OF
21550WHEN1:IF FNsprites=0 THEN PROCtitlesprite
21560WHEN2:PROCreset_action
21570ENDCASE
21580
21590REM Brushes
21600WHEN60,61,62,63,64,65
21610A%=!Ac%-60
21620CASE !rect_brush_mode OF
21630WHEN0:CASE step% OF
21640WHEN1:A%=(MX DIV 2)-16:B%=255-((MY DIV 4)+8)
21650CALL brusheor%
21660WAIT:WAIT:CALL brusheor%
21670WHEN2:REPEAT
21680PROCmouse_handle
21690B%=MX-32:C%=MY+32:CALL brushdraw%
21700UNTIL MB=0
21710ENDCASE
21720WHEN1:CASE step% OF
21730WHEN1,2:PROCgetrectangle
21740WHEN3:PROCpoint(0,0)
21750PROCsortcord
21760B%=x1%:C%=y1%:D%=xs%DIV2:E%=-ys%DIV4
21770CALL brushdraw%
21780PROCupdate
21790ENDCASE
21800WHEN2:CASE step% OF
21810WHEN1:x0%=640:y0%=512
21820CIRCLE x0%,y0%,SQR((MX-x0%)^2+(MY-y0%)^2)
21830WAIT:WAIT
21840CIRCLE x0%,y0%,SQR((MX-x0%)^2+(MY-y0%)^2)
21850R%=SQR((MX-x0%)^2+(MY-y0%)^2)
21860WHEN3:REPEAT
21870PROCmouse_handle
21880AN=RAD(RND(360)):RO%=TAN(RAD(RND(80)))*(R%/10)
21890B%=MX+SIN(AN)*RO%
21900C%=MY+COS(AN)*RO%
21910CALL brushdraw%
21920UNTIL MB=0
21930ENDCASE
21940ENDCASE
21950
21960REM Anti aliased squash
21970WHEN67:CASE step% OF
21980WHEN1,2:PROCgetrectangle
21990WHEN3:x3%=MX:y3%=MY
22000WHEN4:RECTANGLE x3%,y3%,MX-x3%,MY-y3%
22010WAIT:WAIT:RECTANGLE x3%,y3%,MX-x3%,MY-y3%
22020x4%=MX:y4%=MY
22030WHEN5:PROCcopysort
22040x3%=(x3%DIV2)*2
22050x4%=(x4%DIV2)*2
22060y3%=(y3%DIV4)*4
22070y4%=(y4%DIV4)*4
22080IF x3%>x4% THEN temp%=x3%:x3%=x4%:x4%=temp%
22090IF y4%>y3% THEN temp%=y4%:y4%=y3%:y3%=temp%
22100xps%=x4%-x3%+3:yps%=y4%-y3%-7
22110A%=x1%
22120B%=y1%
22130C%=xs%DIV2
22140D%=-ys%DIV4
22150E%=x3%
22160F%=y3%
22170G%=xps%DIV2
22180H%=-yps%DIV4
22190CALL anti_aliased_squash%
22200ENDCASE
22210
22220REM Fuzz
22230WHEN68:CASE step% OF
22240WHEN1:x0%=640:y0%=512
22250CIRCLE x0%,y0%,SQR((MX-x0%)^2+(MY-y0%)^2)
22260WAIT:WAIT
22270CIRCLE x0%,y0%,SQR((MX-x0%)^2+(MY-y0%)^2)
22280R%=SQR((MX-x0%)^2+(MY-y0%)^2)
22290WHEN3
22300REPEAT
22310PROCmouse_handle
22320AN1=RAD(RND(360)):RO1%=TAN(RAD(RND(80)))*(R%/10)
22330AN2=RAD(RND(360)):RO2%=TAN(RAD(RND(80)))*(R%/10)
22340A%=MX+SIN(AN1)*RO1%
22350B%=MY+COS(AN1)*RO1%
22360C%=MX+SIN(AN2)*RO2%
22370D%=MY+COS(AN2)*RO2%
22380CALL swap_pixels%
22390UNTIL MB=0
22400ENDCASE
22410
22420REM Options
22430WHEN69,70,78,79
22440CASE !Ac% OF
22450WHEN69:select=TRUE
22460WHEN70:select=FALSE
22470WHEN78:!left_handed=0
22480WHEN79:!left_handed=1
22490ENDCASE
22500PROCreset_action
22510
22520REM Pixellate
22530WHEN71:CASE step% OF
22540WHEN1,2:PROCgetrectangle
22550WHEN3:PROCsortcord
22560gsx%=ABS(x1%-MX):gsy%=ABS(y1%-MY)
22570gsx%=(gsx% DIV 2)*2
22580gsy%=(gsy% DIV 4)*4
22590IF gsx%<4 THEN gsx%=4
22600IF gsy%<8 THEN gsy%=8
22610PROCpixgrid
22620WAIT:WAIT
22630PROCpixgrid
22640WHEN4:PROCpoint(0,0)
22650FOR gy%=y1% TO y2% STEP -gsy%
22660FOR gx%=x1% TO x2% STEP gsx%
22670sx%=gsx%:sy%=gsy%
22680IF gx%+sx%>x2% THEN sx%-=gx%+sx%-x2%-2
22690IF gy%-sy%<y2% THEN sy%-=y2%-(gy%-sy%)-4
22700A%=gx%:B%=gy%:C%=sx%DIV2:D%=sy%DIV4
22710CALL COLaverage%
22720NEXT
22730NEXT
22740MOUSE RECTANGLE 0,0,1279,1023
22750PROCupdate
22760ENDCASE
22770
22780REM Copy Fill
22790WHEN72:CASE step% OF
22800WHEN1,2:PROCgetrectangle
22810WHEN3:px%=MX:py%=MY
22820WHEN4:PROCcopysort:PROCpoint(0,0)
22830GCOL 128+POINT(MX,MY) TINT TINT(MX,MY)
22840IF !fill_style=0 OR !fill_style=3 THEN !fill_style=2
22850CASE !fill_style OF
22860WHEN1,2,3:
22870CALL bit_map_scan_A%
22880PLOT&85,MX,MY
22890A%=x1%DIV2:B%=y1%DIV4:C%=xs%DIV2:D%=-ys%DIV4
22900CASE !fill_style OF
22910WHEN1,2:CALL copy_fill%
22920WHEN3:REM Should be full mapping.
22930ENDCASE
22940ENDCASE
22950PROCupdate
22960ENDCASE
22970
22980REM Save Compacted Sprite
22990WHEN73:IF FNtext_entry(33,$screen_str%,255) THEN
23000PROCpoint(0,1):PROCcompactedsave(1,out$)
23010area$=STR$(xs%*ys%)
23020per$=LEFT$(STR$(cs%/(xs%*ys%)*100),4)
23030IF INKEY(-1) THEN PROCerrorhandle(1,"Compaction Report|Size: "+STR$(xs%)+"x"+STR$(ys%)+"|Area in bytes: "+area$+"|Bytes used: "+STR$(cs%)+"|Percentage: "+per$," ",selected)
23040$screen_str%=out$
23050ENDIF
23060PROCreset_entry
23070
23080REM Compacted Get
23090WHEN74:CASE step% OF
23100WHEN1,2:PROCgetrectangle
23110WHEN3:PROCsortcord
23120!com_x1=x1%
23130!com_y1=y1%
23140!com_x2=x2%
23150!com_y2=y2%
23160ENDCASE
23170
23180REM Mode 15 to 13 convert
23190WHEN75:CASE step% OF
23200WHEN1,2:PROCgetrectangle
23210WHEN3:PROCsortcord:xs%-=2:ys%+=4:px%=MX:py%=MY
23220RECTANGLE px%,py%,xs%/2,-ys%
23230WAIT:WAIT
23240RECTANGLE px%,py%,xs%/2,-ys%
23250WHEN4:PROCsortcord
23260A%=x1%:B%=y1%:C%=xs%DIV4:D%=-ys%DIV4:E%=px%:F%=py%-ys%-4
23270CALL COLmode15_13resize%
23280ENDCASE
23290
23300REM Colour Average Area
23310WHEN76:CASE step% OF
23320WHEN1,2:PROCgetrectangle
23330WHEN3:PROCsortcord
23340A%=x1%:B%=y1%:C%=xs%DIV2:D%=-ys%DIV4
23350CALL COLaverage%
23360ENDCASE
23370
23380REM Update Font List
23390WHEN77
23400CALL fontlistinit%
23410PROCreset_action
23420
23430REM 3 point curve
23440WHEN80:CASE step% OF
23450WHEN1:x1%=MX:y1%=MY
23460WHEN2:x2%=MX:y2%=MY
23470MOVE x1%,y1%:DRAW x2%,y2%
23480WAIT:WAIT
23490MOVE x1%,y1%:DRAW x2%,y2%
23500WHEN3:x3%=MX:y3%=MY
23510PROCcurve(20):WAIT:WAIT:PROCcurve(20)
23520WHEN4:PROCcurve(1)
23530ENDCASE
23540
23550REM Bottle Wall Formula
23560WHEN81:IF FNtext_entry(32,botrad$,255) THEN botrad$=out$
23570PROCreset_entry
23580
23590REM Undo Brush
23600WHEN82:CASE step% OF
23610WHEN1:A%=(MX DIV 2)-16:B%=255-((MY DIV 4)+8)
23620CALL brusheor%
23630WAIT:WAIT:CALL brusheor%
23640WHEN2:REPEAT
23650PROCmouse_handle
23660A%=(MX DIV 2)-16:B%=255-((MY DIV 4)+8)
23670CALL brushundo%
23680UNTIL MB=0
23690ENDCASE
23700
23710ENDCASE
23720ENDPROC
23730
23740DEFPROCcurve(r%)
23750PLOT &45,x1%,y1%
23760xs%=x1%-x2%:ys%=y1%-y2%
23770xs2%=(x1%-xs%/2)-x3%:ys2%=(y1%-ys%/2)-y3%
23780IF r%<>1 THEN
23790s%=r%
23800ELSE
23810IF ABSxs%>ABSys% THEN s%=ABSxs% ELSE s%=ABSys%
23820ENDIF
23830FOR st=1/s% TO 1-1/s% STEP 1/s%
23840x%=x1%-(xs%*st)-(xs2%*SINRAD(st*180))
23850y%=y1%-(ys%*st)-(ys2%*SINRAD(st*180))
23860PLOT &25,x%,y%
23870NEXT
23880PLOT &25,x2%,y2%
23890ENDPROC
23900
23910DEFFNtext_entry(sl%,in$,len%)
23920!putit%=1
23930PROCpoint(0,PNkeyboard)
23940PROCreset_action:CALL uptree%
23950A%=-128:B%=!starty%+56:E%=-1:CALL help%
23960A%=-128:B%=!starty%-!sizey-96:E%=-1:CALL help%
23970step%=1
23980go=FNinstring(sl%,126,in$,out$,len%)
23990CALL liftup%:CALL putbackground%
24000=go
24010
24020DEFPROCreset_entry
24030CALL liftdown%:VDU5:CALL helptext%:PROCupdate
24040ENDPROC
24050
24060DEFPROCeval_error_cheat
24070LOCAL ERROR
24080ON ERROR LOCAL eval$="":VDU7:t$=REPORT$:RESTORE ERROR:ENDPROC
24090IF ASC(eval$)=126 THEN t$=STR$~(EVAL(MID$(eval$,2))) ELSE t$=STR$(EVAL(eval$))
24100RESTORE ERROR
24110ENDPROC
24120
24130DEFPROCcompactedsave(t%,fn$)
24140LOCAL ERROR
24150ON ERROR LOCAL CALL undosave%:RESTORE ERROR:ERROR 99,REPORT$:ENDPROC
24160OSCLI"DefineBuffer "+STR$(STORE%)+" &28000"
24170CASE t% OF
24180WHEN0:OSCLI"Com_Save "+fn$+" 0 0 1279 1023 0"
24190WHEN1:IF ?(flags%+1)=0 THEN tl%=behind% ELSE tl%=0
24200OSCLI"Com_Save "+fn$+" "+STR$(!com_x1)+" "+STR$(!com_y1)+" "+STR$(!com_x2)+" "+STR$(!com_y2)+" "+STR$(tl%)
24210ENDCASE
24220cs%=10
24230xs%=10
24240ys%=10
24250CALL undosave%
24260RESTORE ERROR
24270ENDPROC
24280
24290DEFPROCcompressedsave(fn$)
24300LOCAL ERROR
24310ON ERROR LOCAL CALL undosave%:RESTORE ERROR:ERROR 99,REPORT$:ENDPROC
24320$cat%=fn$
24330CALL compactedsave%
24340CALL undosave%
24350RESTORE ERROR
24360ENDPROC
24370
24380DEFPROCpixgrid
24390RECTANGLE x1%,y1%,xs%,ys%
24400FOR X%=x1%+gsx% TO x2% STEP gsx%
24410LINE X%,y1%,X%,y2%
24420NEXT
24430FOR Y%=y1%-gsy% TO y2% STEP -gsy%
24440LINE x1%,Y%,x2%,Y%
24450NEXT
24460ENDPROC
24470
24480DEFFNsprites
24490CALL checksprites%
24500=!OUT
24510
24520DEFFNput_check
24530IF FNsprites>0 THEN =TRUE
24540PROCreset_action
24550IF !Ac%=37 OR !Ac%=40 THEN !Ac%=38:ERROR 99,"No Sprites Present. Unable to Restore Action, Setting Action to Sprite Get."
24560=FALSE
24570
24580DEFPROCtitlesprite
24590LOCAL ERROR
24600ON ERROR LOCAL RESTORE ERROR:ENDPROC
24610MOVE 52,711:MOVE 274,932:*SGET Diamond
24620RESTORE ERROR:ENDPROC
24630
24640REM formula functions
24650
24660DEF FNradiusR
24670=SQR(XR^2+YR^2)
24680
24690DEF FNradiusD
24700=SQR(XD^2+YD^2)
24710
24720DEF FNdepth
24730LOCAL r%,g%,b%,t%
24740t%=(col% AND 192)>> 6
24750r%=t%+(col% AND 3)<<2
24760g%=t%+(col% AND 12)
24770b%=t%+(col% AND 48)>>2
24780t%=r%
24790IF g%>t% THEN t%=g%
24800IF b%>t% THEN t%=b%
24810=t%/15
24820
24830DEF FNwedge(up%,down%)
24840IF col%=up% THEN wedge%+=1
24850IF col%=down% THEN wedge%-=1
24860=wedge%
24870
24880DEFPROCsmearscreen(x1%,y1%,xs%,ys%)
24890PROCcopysort
24900c1%=(px1%-px4%)
24910c2%=(py1%-py4%)
24920c3%=(ys%)
24930c4%=(xs%)
24940c5%=(px2%-px1%)
24950c6%=(py2%-py1%)
24960c7%=(px3%-px4%)-c5%
24970c8%=(py3%-py4%)-c6%
24980PROCpoint(0,0)
24990FOR yp%=y1% TO y1%+ys% STEP SGN(ys%)*4
25000arx%=0
25010FOR xp%=x1% TO x1%+xs% STEP SGN(xs%)*2
25020IF yp%=y1% THEN A%(arx%,0)=FNnpx(xp%,yp%):A%(arx%,1)=FNnpy(xp%,yp%):GOTO 25120
25030IF arx%=0 THEN nplx%=FNnpx(xp%,yp%):nply%=FNnpy(xp%,yp%):GOTO 25100
25040plt%=FNgcol(xp%-2,yp%+4)
25050MOVE tx%,ty%
25060MOVE A%(arx%,0),A%(arx%,1)
25070IF plt% THEN PLOT &55,nplx%,nply%
25080nplx%=FNnpx(xp%,yp%):nply%=FNnpy(xp%,yp%)
25090IF plt% THEN PLOT &55,nplx%,nply%
25100tx%=A%(arx%,0):ty%=A%(arx%,1)
25110A%(arx%,0)=nplx%:A%(arx%,1)=nply%
25120arx%=arx%+1
25130NEXT xp%,yp%
25140step%=1
25150ENDCASE
25160PROCupdate
25170ENDPROC
25180
25190DEF FNnpx(PX,PY)
25200w1=((PY-y1%)/c3%)
25210w2=((PX-x1%)/c4%)
25220=px1%-(c1%*w1)+(c5%+c7%*w1)*w2
25230
25240DEF FNnpy(PX,PY)
25250=py1%-(c2%*w1)+(c6%+c8%*w1)*w2
25260
25270DEF FNatn(X,Y)
25280IF ABS(Y)>0 THEN A=DEG(ATN(X/Y)) ELSE A=90+180*(X<0)
25290IF Y<0 THEN A=A+180
25300=A
25310
25320DEF FNradius(X,Y)
25330=SQR(X^2+Y^2)
25340
25350DEFPROCshape
25360A=FNatn(MX-x3%,MY-y3%)
25370D=FNradius(MX-x3%,MY-y3%)
25380OA1=2*(DEG(ATN(ABS(xs%)/ABS(ys%))))
25390OA2=180-OA1
25400px1%=x3%+D*SIN(RAD(A))
25410py1%=y3%+D*COS(RAD(A))
25420px2%=x3%+D*SIN(RAD(A+OA1))
25430py2%=y3%+D*COS(RAD(A+OA1))
25440px3%=x3%+D*SIN(RAD(A+OA1+OA2))
25450py3%=y3%+D*COS(RAD(A+OA1+OA2))
25460px4%=x3%+D*SIN(RAD(A-OA2))
25470py4%=y3%+D*COS(RAD(A-OA2))
25480MOVE px1%,py1%
25490GCOL 3,3
25500DRAW px2%,py2%
25510GCOL 3,63
25520DRAW px3%,py3%
25530DRAW px4%,py4%
25540DRAW px1%,py1%
25550ENDPROC
25560
25570DEF FNformx(xpos,ypos,upval)
25580rd=FNradius(xpos,ypos)
25590an=RAD(FNatn(xpos,ypos))
25600an=an+offset
25610=mx%+SIN(an)*rd*(xs2%/720)
25620
25630DEF FNformy(xpos,ypos,upval)
25640=my%+COS(an)*rd*(ys2%/720)*COS(lean)+upval*SIN(lean)
25650
25660DEF FNboltx(A)
25670=!(xget%+A*4)
25680DEF FNbolty(A)
25690=!(yget%+A*4)
25700
25710DEFPROCoscliaction
25720LOCAL ERROR
25730*POINTER 0
25740*FX 4,0
25750*FX 229,0
25760SYS "OS_RestoreCursors"
25770PROCreset_action
25780PROCsetsoftkeys
25790CALL uptree%
25800PRINT
25810ON ERROR LOCAL PRINT:PRINT REPORT$
25820REPEAT
25830INPUT "*"out$
25840IF LEFT$(out$,8)<>"MENU OFF" THEN OSCLI out$
25850UNTIL LEFT$(out$,8)="MENU OFF" OR MODE<>15 OR out$=""
25860IF MODE<>15 THEN MODE 15
25870*FX 229,1
25880SYS "OS_RemoveCursors"
25890!putit%=1:CALL putbackground%
25900RESTORE ERROR
25910REM VDU 21
25920*FX 4,1
25930PROCunsetsoftkeys
25940PROCpoint(0,0)
25950IF LEFT$(out$,8)="MENU OFF" THEN OSCLI MID$(out$,9)
25960IF MODE<>15 THEN MODE 15:!putit%=1:CALL putbackground%
25970CALL liftdown%
25980PROCupdate
25990ENDPROC
26000
26010DEFPROCdumpererror
26020P%=!printmenu%
26030[OPT0
26040EQUS"< Printer Dumps"
26050EQUB1:EQUB255
26060EQUS"Not Installed":EQUB 0:EQUB 33
26070]
26080ENDPROC
26090
26100DEFPROCcheckdumper
26110LOCAL ERROR
26120ON ERROR LOCAL PROCdumpererror:RESTORE ERROR:ENDPROC
26130P%=!printmenu%
26140OSCLI ("SCREENDUMPIDS &"+STR$~(P%))
26150RESTORE ERROR
26160ENDPROC
26170
26180DEFPROCgetrectangle
26190CASE step% OF
26200WHEN1:x1%=MX:y1%=MY
26210WHEN2:RECTANGLE x1%,y1%,MX-x1%,MY-y1%
26220WAIT:WAIT:RECTANGLE x1%,y1%,MX-x1%,MY-y1%
26230xs%=MX-x1%:ys%=MY-y1%
26240x2%=MX:y2%=MY
26250ENDCASE
26260ENDPROC
26270
26280DEFPROCsortcord
26290x1%=(x1%DIV2)*2
26300x2%=(x2%DIV2)*2
26310y1%=(y1%DIV4)*4
26320y2%=(y2%DIV4)*4
26330IF x1%>x2% THEN temp%=x1%:x1%=x2%:x2%=temp%
26340IF y2%>y1% THEN temp%=y2%:y2%=y1%:y1%=temp%
26350xs%=x2%-x1%+3:ys%=y2%-y1%-7
26360ENDPROC
26370
26380DEF FNgcol(xp%,yp%)
26390IF !pm%<>2 THEN
26400GCOL POINT(xp%,yp%) TINT TINT(xp%,yp%)
26410col%=POINT(xp%,yp%)+TINT(xp%,yp%)
26420=TRUE
26430ELSE
26440A%=xp%DIV2:B%=(-ys%-yp%)DIV4
26450CALL spritepix%
26460col%=!RESULTX
26470=!spritemask
26480ENDIF
26490
26500DEFPROCspritesort
26510CALL spriteinit%
26520x1%=0:y1%=4*!sprint_ysize
26530xs%=2*!sprint_xsize
26540ys%=-4*!sprint_ysize
26550x2%=xs%
26560y2%=0
26570ENDPROC
26580
26590DEFPROCcopysort
26600wedge%=0
26610CASE !pm% OF
26620WHEN0,1:REM solid,pattern
26630PROCsortcord
26640WHEN2:REM sprite
26650PROCspritesort
26660ENDCASE
26670ENDPROC
26680
26690DEFFNinstring(min,max,in$,RETURN out$,length)
26700l%=!sizex/8-2
26710*FX 4,1
26720*FX 229,1
26730OMX=-1:OMY=-1
26740XP=!startx%+6:YP=!starty%-48
26750MOVE XP,YP:VDU 5
26760out$=in$:posit%=LEN(out$)+1:of%=posit%-l%+1:IF of%<1 THEN of%=1
26770GCOL 0,5 TINT 64:PRINT">";
26780REPEAT
26790MOVE XP+16,YP:
26800GCOL 0,(BACKCOL% AND 63) TINT (BACKCOL% AND 192)
26810PRINTSTRING$(l%,CHR$(255))
26820GCOL 0,(textcol% AND 63) TINT (textcol% AND 192)
26830MOVE XP+16,YP:PRINTMID$(out$,of%,l%)
26840GCOL 3,63 TINT 192
26850RECTANGLE FILL XP+(posit%-of%+1)*16,YP,16,-28
26860REPEAT
26870MOUSE DX,DY,MB
26880IF DX<>OMX OR DY<>OMY THEN PROCpoint(0,PNkeyboard)
26890A$=INKEY$(0)
26900IF A$<>"" THEN *POINTER 0
26910UNTIL A$<>"" OR MB>0
26920OMX=DX:OMY=DY
26930RECTANGLE FILL XP+(posit%-of%+1)*16,YP,16,-28
26940MOVE XP+16,YP
26950i$="":IF ASC(A$)>min-1 AND ASC(A$)<max+1 THEN i$=A$
26960IF ASC(A$)=163 THEN i$=A$
26970IF ASC(A$)=21 THEN out$="":of%=1:posit%=1
26980IF LEN(out$)=length AND i$<>"" THEN VDU 7
26990IF i$<>"" AND LEN(out$)<length THEN out$=LEFT$(out$,posit%-1)+A$+MID$(out$,posit%):posit%=posit%+1
27000IF ASC(A$)=127 THEN
27010IF posit%>1 THEN out$=LEFT$(out$,posit%-2)+MID$(out$,posit%):posit%=posit%-1 ELSE VDU 7
27020ENDIF
27030IF ASC(A$)=136 THEN posit%=posit%-1
27040IF ASC(A$)=137 THEN posit%=posit%+1
27050IF (posit%-of%+1)>l% THEN of%+=1
27060IF (posit%-of%)<4 THEN of%=posit%-4
27070IF of%<1 THEN of%=1
27080IF posit%<1 THEN posit%=1
27090IF posit%>LEN(out$)+1 THEN posit%=LEN(out$)+1
27100IF ASC(A$)=27 THEN =FALSE
27110IF MB=1 THEN =FALSE
27120UNTIL ASC(A$)=13 OR MB=4
27130VDU 4:*FX 4,0
27140=NOT (LEN(out$)=0)
27150
27160DEFPROCsetcol
27170GCOL 0,(textcol% AND 63) TINT (textcol% AND 192)
27180GCOL 0,128+(BACKCOL% AND 63) TINT (BACKCOL% AND 192)
27190ENDPROC
27200
27210DEFPROCpoint(L,N)
27220P%=PO%+N*267
27230SYS &400D8,2,P%+11,32,32,P%?9,P%?10
27240MOUSE COLOUR 1,P%?0,P%?1,P%?2
27250MOUSE COLOUR 2,P%?3,P%?4,P%?5
27260MOUSE COLOUR 3,P%?6,P%?7,P%?8
27270OSCLI "FX 106,"+STR$(2 OR L<<7)
27280ENDPROC
27290
27300DEF FNbuild_formula(A$,pos%)
27310REM A$=eval of the formula,pos=formula number
27320LOCAL ERROR
27330ON ERROR LOCAL RESTORE ERROR:=FALSE
27340FOR Y%=0 TO 20
27350FOR X%=0 TO 20
27360XD=X%*36-360
27370YD=Y%*36-360
27380XR=RAD(XD):YR=RAD(YD)
27390A=(EVAL(A$)<<8)
27400!(skel%+pos%*1764+(X%+21*Y%)*4)=A
27410NEXT
27420NEXT
27430RESTORE ERROR
27440=TRUE
27450
27460DEFPROCformula_load(filename$)
27470REM reads and descifers a formula list
27480SYS "OS_Find",&40,filename$ TO handle%
27490formulas%=1
27500P%=formnames%
27510[OPT 0
27520EQUB 7
27530EQUB 10
27540EQUS "Defineable"
27550]
27560name$="":formulas$(formulas%-1)="":past%=FALSE
27570REPEAT
27580SYS "OS_GBPB",4,handle%,log_scale%,1 TO ,,,finish%
27590b%=?log_scale%:cr%=(b%=10 OR b%=13)
27600IF cr% THEN
27610IF past% THEN
27620IF FNbuild_formula(formulas$(formulas%-1),formulas%) THEN ?P%=LEN(name$):P%+=1:$P%=name$:P%+=LEN(name$):formulas%+=1
27630ENDIF
27640name$="":formulas$(formulas%-1)="":past%=FALSE
27650ELSE
27660IF past% THEN formulas$(formulas%-1)+=CHR$(b%)
27670IF b%=ASC("$") THEN past%=TRUE
27680IF NOT past% THEN name$+=CHR$(b%)
27690ENDIF
27700UNTIL finish%=1
27710?formnames%=formulas%
27720SYS "OS_Find",&00,handle%
27730ENDPROC
27740
27750DEFPROCupdate
27760IF (mgs AND mousegrid>2) OR mcs THEN l=1 ELSE l=0
27770CASE !Ac% OF
27780WHEN12:PROCpoint(l,PNglass)
27790WHEN13:PROCpoint(l,PNflood):CALL mousecolour%
27800WHEN21,33,34:PROCpoint(l,PNspray):CALL mousecolour%
27810WHEN37,38:PROCpoint(l,PNspriteop)
27820WHEN31,32,35:PROCpoint(l,PNbrush)
27830WHEN41:PROCpoint(0,PNspray)
27840WHEN59:PROCpoint(l,PNA)
27850OTHERWISE:PROCpoint(l,PNnormal):CALL mousecolour%
27860ENDCASE
27870ENDPROC
27880
27890DEFPROCerror_at
27900VDU 26
27910IF ERR=17 THEN
27920step%=1:PROCpoint(0,PNstopped)
27930CALL liftdown%
27940FOR R%=0 TO 20000:NEXT
27950PROCupdate
27960ENDPROC
27970ENDIF
27980IF !lastmenu=12 OR !lastmenu=30 THEN CALL uptree%
27990VDU 7
28000CASE testing OF
28010WHENFALSE:PROCerrorhandle(1,"An Error Has Occured,|"+REPORT$,"Continue",selected)
28020WHENTRUE:PROCerrorhandle(3,"An Error Has Occured,|"+REPORT$+"|At line "+STR$(ERL),"Edit This Line|Edit Last Line|Continue",selected)
28030*FX 15,0
28040IF selected=1 THEN PROCstring_to_buffer("ED. "+STR$(ERL)+CHR$(13))
28050IF selected=2 THEN PROCstring_to_buffer("ED.."+CHR$(13))
28060IF selected=1 OR selected=2 THEN END
28070ENDCASE
28080step%=1
28090IF !lastmenu<>1 AND !lastmenu<>9 THEN !presentmenu%=!lastmenu
28100ENDPROC
28110
28120DEFPROCerrorhandle(N,message$,question$,RETURN selected)
28130IF MODE<>15 THEN MODE 15:SYS "OS_RemoveCursors"
28140*FX229,1
28150PROCpoint(0,PNquestion)
28160MOUSE RECTANGLE 256,331,768,372
28170A%=N:CALL draw_error_box%
28180VDU 28,32,19,59,12
28190COLOUR 128+(BACKCOL% AND 63) TINT (BACKCOL% AND 192)
28200COLOUR (textcol% AND 63) TINT (textcol% AND 192)
28210PROCstrhandle(message$)
28220SYS "OS_PrettyPrint",BUFF%
28230COLOUR 63 TINT 192
28240PRINTTAB(0,5);
28250PROCstrhandle(question$+" ?")
28260SYS "OS_PrettyPrint",BUFF%
28270PROCBUTOFF(7)
28280REPEAT
28290MOUSE DX,DY,ChB
28300IF ChB>0 AND DX>308 AND DX<463 AND DY<653 AND DY>516 AND ChB<>2 THEN !presentmenu%=0:!lastmenu=0:ChB=2:!treepos=0:!Ac%=0
28310UNTIL ChB=2 OR (ChB>0 AND DX>300 AND DX<474 AND DY<484 AND DY>368)
28320PROCBUTOFF(7)
28330CALL undorestore%
28340PROCupdate
28350CALL liftdown%
28360VDU5:CALL helptext%
28370F%=step%:CALL helpstep%
28380selected=INT((484-DY)/120*N)+1
28390IF ChB=2 THEN enter%=10:selected=-1
28400ENDPROC
28410
28420DEFPROCstrhandle(string$)
28430out$=""
28440FOR R=1 TO LEN(string$)
28450ch$=MID$(string$,R,1)
28460IF ch$="|" THEN ch$=CHR$(13)
28470out$=out$+ch$
28480NEXT
28490$BUFF%=out$+CHR$(0)
28500ENDPROC
28510
28520DEFPROCsetlimits(LMX,LMY)
28530mrctx1%=-LMX+2
28540mrcty1%=-LMY+4
28550mrctx2%=1277+LMX
28560mrcty2%=1019+LMY
28570ENDPROC
�> <Atelier$Dir>.Atelier
3� By Simon Clay Copyright (c) Simon Clay, 1989
: version$="1.02"
(
2
<�:�error(�,�$,�,�)
F �init
P�:�error(�,�$,�,�):�report
Z�normpoint
d`� �okfile_at(start_file$,-1,start_t%) � t%=start_t%:start_t%=-1:�loadfile(start_file$,-1,t%)
n
x�
�(ș "Wimp_PollIdle",,q%,1E9 � reason%
��respond(reason%)
�
�quit%
� �quit
��
�
���respond(reason%)
��waitpoint
�Ȏreason%�
��0:
��1:
�9�2:�open(!q%,q%!4,q%!8,q%!12,q%!16,q%!20,q%!24,q%!28)
��3:�closew(!q%)
�4:
�5:
.�6:�mouse(!q%,q%!4,q%!8,q%!12,q%!16,q%!20)
"�7:�enddrag
,�8:
6�9:�menuselect
@�10
J�11
T�12
^�17,18:�umess1
h�19:�umess2
r�
|�normpoint
��
�
���quit:�normpoint
��debug:�tidy:�
�2$q%="TASK":ș "Wimp_CloseDown",taskhandle%,!q%
�Ș
�
�
��init
�� q% 2500, workbuf% 100
�appl$="Atelier"
��findmos
�waiter%=0:�waitpoint
�
testing=�
C� os%=2 � ș "OS_GetEnv" � SA$:� �SA$,7,5)<>"-quit" � testing=�
�init_at
�checkmos
&*fx229,1
0wimpsaved%=�
:$v%=�initwimp:�v%<180:�12:�err(2)
D)quit%=�:dialogue%=-1E9:stopreason%=-1
Nackpending%=�:ackref%=-1
Xdragreason%=-1:help$=""
bsavereason%=-1
l�defws:�defmenus:�version
vcheckref%=-1
�as$="Are you sure ?"
��baricon
�� find start bit
�start_file$="":start_t%=-1
�� �
�+� � � start_file$="":start_t%=-1:� �T~C
�ș "OS_GetEnv" � r0,r1,r2
� A$=""
�&� ?r0<>0 � A$+=�(?r0):r0+=1:� �dPB
�-� �A$," ")<>0 � A$=�A$,�A$," ")+1):� �dZB
�� A$<>"" �
� ș "OS_File",5,A$ � r0,r1,r2
�� r0=1 �
>� ((r2 � &FFF00000)=&FFF00000) � start_t%=(r2 � &FFF00)>>8
start_file$=A$
�
�
*�
4� end start bit
>�
H
R
��version
\/�T$:T$=version$:笤prod:T$+=" *UNFINISHED*"
f�seti(w_pinfo%,4,"v"+T$)
p�
z
�,ݤprod=�version$,�version$,".")+1,1)="0"
�ݤdebug=��prod ��-1��-2
�
�ݤinitwimp
�E$q%="TASK":ș "Wimp_Initialise",200,!q%,"Atelier"�!q%,taskhandle%
�=!q%
�
�
��tidy
��normpoint
��4:�0,2);:*fx4
�*fx225,1
�
*fx229
��:�:�" ";�:�
�
��baricon
$*!q%=-1:q%!4=0:q%!8=0:q%!12=64:q%!16=68
.-q%!20=%11000000000010:$(q%+24)="!Atelier"
8$ș"Wimp_CreateIcon",,q%�baricon%
B�
L
V!��error(err%,err$,erl%,quit%)
`.�normpoint:dragreason%=-1:@%=&90A:*fx229,1
j�i%,e%,t$,T$
t�debug:err$+=" ("+Þ+")"
~�
���:�error(�,�$,�,�)
�9!q%=err%:$(q%+4)=err$:ș"Wimp_ReportError",q%,1,appl$
��quit%:�quit
��
�
�*��report:�debug:�4:�:�" @ ";�:�tidy:�
��
�
� ݤdir
� �T$:T$=�ArfVar(appl$+"$Dir")
��T$="":T$="&.!"+appl$+"."
���T$)<>".":T$+="."
=T$
ݤArfVar(A$)
�
(
��:=""
2"ș&23,A$,workbuf%,200,0,3�,,L%
<workbuf%?L%=13:=$workbuf%
F
P��umess1
Z-ref%=q%!8:task%=q%!4:�task%=taskhandle%:�
dmess%=q%!16
nȎmess%�
x�0:�quit
��1:�datasaved
��2:�savedata
��3:�dataload
��4:ackpending%=�
��5:�dataopen
��6:
��7:
��8:�prequit
��9:
�
�&502:
�-�&400C0:�submenu(q%!20,q%!24,q%!28,q%+32)
��
��
��dataopen
�s%,t%
"'file$=�zts(q%+44):s%=q%!36:t%=q%!40
,?�okfile_at(file$,s%,t%)�dataloadack:�loadfile(file$,s%,t%)
6�
@
J��dataload
T
�s%,t%
^'file$=�zts(q%+44):s%=q%!36:t%=q%!40
h?�okfile_at(file$,s%,t%)�dataloadack:�loadfile(file$,s%,t%)
r�
|
���datasaved
�
�s%,t%
�'file$=�zts(q%+44):s%=q%!36:t%=q%!40
�(�okfile_at(file$,s%,t%)�datasaveack
��
�
���template(T$)
��template1(T$,q%)
��
�
���template1(T$,q%)
�� c%:$workbuf%=T$
�Jș "Wimp_LoadTemplate",,q%,curbuf%,endbuf%,-1,workbuf%�,,curbuf%,,,,c%
.� c%=0 � � 1,"Template '"+T$+"' not found"
�
&��defws
0�I%
:bufsz%=&1000
D;� buffer% bufsz%:curbuf%=buffer%:endbuf%=buffer%+bufsz%
N'ș"Wimp_OpenTemplate",,�dir+"AtFrm"
XB�template("stopbox"):q%!64=1:ș"Wimp_CreateWindow",,q%�w_stop%
b?�template("save"):q%!64=1:ș"Wimp_CreateWindow",,q%�w_save%
l<�template("ProgInfo"):ș"Wimp_CreateWindow",,q%�w_pinfo%
vș"Wimp_CloseTemplate"
�free%=endbuf%-curbuf%
��
�
���defmenus
��t$
�� mlist% 32,function% 51
�bufsz%=&200
�C� menufree% bufsz%:menuptr%=menufree%:menuend%=menufree%+bufsz%
�menustart%=menufree%:�+2
��t$:m_save%=�crmenu(t$)
��"#Save,Compressed Screen}w_save%,System Screen}w_save%,Super Compacted Screen}w_save%,Super Compacted Sprite}w_save%,System Sprite(s)}w_save%,Brush Shapes}w_save%,Patterns}w_save%"
��t$:m_main%=�crmenu(t$)
�/�"#Atelier,Info>w_pinfo%,Save>m_save%,Quit"
�
��front(h%,X%,Y%)
�getw(h%)
*�X%>=0x1%+=X%-x0%:x0%=X%
4�Y%>=0y1%+=Y%-y0%:y0%=Y%
>*�open(h%,x0%,y0%,x1%,y1%,scx%,scy%,-1)
H�
R
\
��top(h%)
f6�getw(h%):�open(h%,x0%,y0%,x1%,y1%,scx%,scy%,-1):�
p
z4��open(oh%,ox0%,oy0%,ox1%,oy1%,oscx%,oscy%,obh%)
��O%
�'!q%=oh%:ș"Wimp_GetWindowState",,q%
�
�wimpopen
��
�
���wimpopen
�5!q%=oh%:q%!4=ox0%:q%!8=oy0%:q%!12=ox1%:q%!16=oy1%
�>q%!20=oscx%:q%!24=oscy%:q%!28=obh%:ș"Wimp_OpenWindow",,q%
��
�
���closew(!q%)
��I%
�ș"Wimp_CloseWindow",,q%
.�!q%=dialogue%:dialreason%=-1:dialogue%=-1
$�dialogue%>=0:�closew(dialogue%)
Ȏ!q%�
$�w_stop%:stopreason%=-1
.�
8�
B
L*ݤia(h%,i%):�geti(h%,i%):�chkii:=q%!28
V*ݤva(h%,i%):�geti(h%,i%):�chkii:=q%!32
`*ݤil(h%,i%):�geti(h%,i%):�chkii:=q%!36
j
t3��chkii:�(q%!24�&100)=0�1,"Icon not indirected"
~�
�
�<��geti(h%,i%):!q%=h%:q%!4=i%:ș"Wimp_GetIconState",,q%:�
�
���stop(r%,T$,U$,T%)
�dialreason%=r%
��-3mi%=3:�mstop:�
�+�seti(w_stop%,0,T$):�seti(w_stop%,1,U$)
�)�unselall(w_stop%):�dialogue(w_stop%)
�dialreason%=r%
��
�
���dialogue(h%)
�X%,Y%
$�dialogue%>=0:�closew(dialogue%)
-�nomenu:�readpointer:X%=mx%-200:Y%=my%-85
�X%<0X%=0
(�Y%<96Y%=96
22dialogue%=h%:�front(h%,X%,Y%):�setct(h%,-1,-1)
<�
F
P!��readpointer:�q%:q%=workbuf%
Zș"Wimp_GetPointerInfo",,q%
d1mx%=!q%:my%=q%!4:mb%=q%!8:mh%=q%!12:mi%=q%!16
n�
x
�ݤdialogue
�!�dialogue%>=0�mh%<>dialogue%�
��closew(dialogue%)
��
�=�
�
�$��mouse(mx%,my%,mb%,mh%,mi%,mo%)
��dragreason%>=0�mb%>255:�
��dialogue:�
�
Ȏmb%�
��2:�menu
��1,4:�select
��16,64:�startdrag
�
�
"6��seti(h%,i%,T$):T$=�T$,�il(h%,i%)):$�ia(h%,i%)=T$
,<�iconupd(h%,i%):�getct:�!q%=h%�q%!4=i%:�setct(h%,i%,�T$)
6�
@
J'��iset(h%,i%,B%,E%):�q%:q%=workbuf%
T?!q%=h%:q%!4=i%:q%!12=B%:q%!8=E%:ș"Wimp_SetIconState",,q%:�
^
h'��iconupd(h%,i%):�iset(h%,i%,0,0):�
r
|��readblock(p%)
�7x0%=!p%:y0%=p%!4:x1%=p%!8:y1%=p%!12:� physical area
�Fscx%=p%!16:scy%=p%!20:bhandle%=p%!24:� scroll offsets, stack depth
�Jbx%=x0%-scx%:by%=y1%-scy%:� calculate physical co-ords of logical area
�>ex0%=p%!40:ey0%=p%!44:ex1%=p%!48:ey1%=p%!52:� logical area
�Agx0%=p%!24:gy0%=p%!28:gx1%=p%!32:gy1%=p%!36:� graphics window
�.open%=(p%!28�&10000)<>0:� window open flag
��
�
���getw(h%)
�&!q%=h%:ș "Wimp_GetWindowInfo",,q%
��readblock(q%+4)
��
�
��select
Ȏmh%�
�-2:enter%=0:�enter_atelier
&�w_stop%:�mstop
0�w_save%:�msave
:�
D�
N
X��mstop
b�mi%<3�mi%>4�
l%�T%:T%=dialreason%:dialreason%=-1
v�mi%=3�
� ȎT%�
��1:�quit
��
��
��closew(w_stop%):�
�
���msave
��mi%<>0�
�g�T$:T$=$�ia(w_save%,2):�T$=�leaf(T$):�99,"To save, please drag the file icon to a directory viewer"
�file$=T$:�savedata1
��
�
���startdrag
"dragreason%=-1:dragbutton%=mb%
Ȏmh%�
6�w_save%:�mi%=3:dragreason%=1:�dragicon(w_save%,3)
�
*�
4
>
��enddrag
H�readpointer
R
�mh%<>-1�
\Ȏdragreason%�
f#�1:file$=�leaf($�ia(w_save%,2))
p-�savereq(file$,savet%,saves%,savereason%)
z�
��
�dragreason%=-1
��
�
�,��unseli(h%,i%):�iset(h%,i%,&200000,0):�
�
�0��seli(h%,i%):�iset(h%,i%,&200000,&200000):�
�
���unselall(h%)
��I%,i%:�wchi(h%)
�(I%=q%:�:i%=!I%:�i%>=0:�unseli(h%,i%)
�I%+=4:�i%<0:�
�
8��wchi(h%):ș "Wimp_WhichIcon",h%,q%,&200000,&200000
�
$
��menu
.
Ȏmh%�
8$�-2:my%=64+3*40:�pop(m_main%,-1)
B�
L�
V
`ݤpar(t$,s$,� i%):�i1%
ji1%=i%+1:i%=�t$+s$,s$,i1%)
t=�t$,i1%,i%-i1%)
~
�ݤcrmenu(menu$)
�.�menufree%+28>menuend%�99,"Menu area full"
�� m%
�menuptr%=menufree%
�i%=0
�C� �menu$,1)="#"i%=1:menutitle$=�par(menu$,",",i%)�menutitle$=""
�$menuptr%=menutitle$
�;menuptr%?12=7:menuptr%?13=2:menuptr%?14=7:menuptr%?15=0
�3menuptr%!16=196-24:menuptr%!20=40:menuptr%!24=0
�"menuptr%+=28:maxx%=�menutitle$
��item$=�par(menu$,",",i%)
��menuitem(item$)
� item$=""
$m%=menufree%:m%!16=(maxx%*8+6)*2
menufree%=menuptr%
=m%
(
2��menuitem(text$)
<.�text$=""menuptr%!-24=(menuptr%!-24)�&80:�
F.�menuptr%+24>menuend%��99,"Menu area full"
P�i%,flg%
Zflg%=&00
di%=�text$,">")
n<�i%>0subptr%=��text$,i%+1):text$=�text$,i%-1)�subptr%=-1
xi%=�text$,"}")
�;�i%>0subptr%=��text$,i%+1):text$=�text$,i%-1):flg%+=&08
�)��text$,1)="#"text$=�text$):flg%+=&02
�;menuptr%!0=flg%:menuptr%!4=subptr%:menuptr%!8=&07000021
��text$,1)="$"�
�2!menuptr%+=&04:menuptr%!8+=&100:i%=�text$,"(")
�3�i%>0�L%=��text$,i%+1):text$=�text$,i%-1)�L%=12
�8menuptr%!12=��text$,2):menuptr%!16=-1:menuptr%!20=L%
�text$=�L%," ")
��
��text$<=12�
�$(menuptr%+12)=text$
��
�%I%=�workspace(�text$+1):$I%=text$
6menuptr%!12=I%:menuptr%!16=-1:menuptr%!20=�text$+1
menuptr%!8=menuptr%!8 � &100
�
"�text$>maxx%maxx%=�text$
,�
6menuptr%+=24
@�
J
Tݤworkspace(L%)
^2� curbuf%+L%>endbuf%�99,"No more buffer space"
hcurbuf%+=L%:=curbuf%-L%
r
|��prep(menu%,tree%)
�
�I%,T$
��clearts(menu%)
�Ȏmenu%�
��m_main%:�mp_main
��
��
�
�
��mp_main
��n%,f$,s%,t%
�
�tree%>0�
��!mlist%=1�
�>n%=mlist%!4:�setfile_at(n%,f$,s%,t%):�saveset(f$,t%,n%,s%)
��
�
�
&��pop(menu%,tree%)
0�menu%<0:�
:�prep(menu%,tree%)
D-ș "Wimp_CreateMenu",,menu%,mx%-50,my%+32
Nopenmenu%=menu%
X�
b
l��nomenu
v(ș"Wimp_CreateMenu",,-1:openmenu%=-1
��
�
���menuselect
��I%
�-I%=0:�mlist%!I%=q%!I%:I%+=4:�q%!(I%-4)=-1
��readpointer
�Ȏopenmenu%�
��m_main%:�m_main
��
��mb%=1�
�#�pop(openmenu%,mlist%):��nomenu
��
��
��m_main
Ȏ!mlist%�
�0:�dialogue(w_pinfo%)
*!�2:�altered_at:�qquit:��quit
4�
>�
H
R��submenu(menu%,X%,Y%,q%)
\
� ;{{{{{{
f�I%
p-I%=0:�mlist%!I%=q%!I%:I%+=4:�q%!(I%-4)=-1
z�prep(openmenu%,mlist%)
�'ș"Wimp_CreateSubMenu",,menu%,X%,Y%
��
�
� ��clearts(mh%):�I%:I%=mh%+28
�"�mh%<menustart%�mh%>menuend%:�
��
�"!I%=!I%��1:I%!8=I%!8��&400000:
�I%+=24:�I%!-24�&80
��
�
���shade(mh%,I%)
�/mh%!(28+8+24*I%)=mh%!(28+8+24*I%)�&400000:�
�
��tick(mh%,I%)
'mh%!(28+24*I%)=mh%!(28+24*I%)�&01:�
$
ݤcommand
.
�T%,I%,T$
8ș"OS_GetEnv" � T$
B�strip(T$)
L=T$
V
`ݤparam
j�I%,T$:T$=�command
tI%=�T$," -quit "):�I%=0:=""
~T$=�T$,I%+7):�strip(T$)
�1I%=�T$," "):�I%>0T$=�T$,I%+1):�strip(T$):�=""
�,I%=�T$," "):�I%>0T$=�T$,I%-1):�strip(T$)
�=T$
�
�ݤfiletype(T$)
�$�T%,U%:ș "OS_File",5,T$ �U%,,T%
�
�T%=0:=-1
�=(T%�&FFF00)>>8
�
���waitpoint
�� os%<>2 �
�waiter%+=1
ș"Hourglass_On"
�
��normpoint
(� os%<>2 �
28ȕwaiter%>0:ș"Hourglass_Off":waiter%-=1:�:waiter%=0
<�
F
P
��help
Z�
d
n��dataloadack
xq%!0=20:q%!12=ref%:q%!16=4
�$ș"Wimp_SendMessage",17,q%,task%
��
�
���datasaveack
�<�ArfVar("Wimp$Scrap")="":�99,"<Wimp$Scrap> not defined"
�A!q%=60:q%!12=ref%:q%!16=2:q%!36=-1:$(q%+44)="<Wimp$Scrap>"+�0
�1ș"Wimp_SendMessage",17,q%,task%:ackref%=q%!8
��
�
���savereq(T$,t%,s%,r%)
�savereason%=r%
�+q%!32=my%:q%!28=mx%:q%!24=mi%:q%!20=mh%
�,q%!16=1:q%!12=0:q%!36=s%:q%!40=t%:!q%=60
9$(q%+44)=T$+�0:ș"Wimp_SendMessage",17,q%,q%!20,q%!24
saveref%=q%!8:�
"��loadmess
,$(q%+44)=file$+�0:!q%=60
67q%!12=ref%:q%!16=3:ș"Wimp_SendMessage",17,q%,task%
@ackpending%=�:�
J
Tݤzts(T%):�T$:T$=""
^ȕ?T%<>0:T$+=�?T%:T%+=1:�
h=T$
r
|+��getct:ș"Wimp_GetCaretPosition",,q%:�
�
�>��setct(h%,i%,o%):ș "Wimp_SetCaretPosition",h%,i%,,,-1,o%
��
�
�ݤleaf(T$)
�
�I%,C%
�$�((�T$,".")=0)�(�T$,":")=0))�=T$
�I%=�(T$)
��
�C%=��T$,I%,1)
� I%-=1
��(I%<=0�C%=�"."�C%=�":")
��I%>0�=�T$,�(T$)-I%-1)
=T$
��scrsz
&H!workbuf%=4:workbuf%!4=5:workbuf%!8=11:workbuf%!12=12:workbuf%!16=-1
01ș "OS_ReadVduVariables",workbuf%,workbuf%+24
:Iq%!32=(workbuf%!32)<<(workbuf%!24):q%!36=(workbuf%!36)<<(workbuf%!28)
D�
N
X��saveset(f$,T%,r%,s%)
b0savereason%=r%:savef$=f$:savet%=T%:saves%=s%
l>�seti(w_save%,2,f$):$�va(w_save%,3)="sfile_"+�"00"+�~T%,3)
v�
�
���dragicon(h%,i%)
��x%,y%,ys%
�,�getw(h%):ys%=y1%-y0%:x%=bx%:y%=y0%-scy%
�1�geti(h%,i%):q%!8+=x%:q%!12+=y%+ys%:q%!16+=x%
�0q%!20+=y%+ys%:q%!24=0:q%!28=0:!q%=0:�drag5:�
�
���drag5:�readpointer:�scrsz
�Fq%!24-=mx%-q%!8:q%!28-=my%-q%!12:q%!32+=q%!16-mx%:q%!36+=q%!20-my%
�!q%!4=5:ș"Wimp_DragBox",,q%:�
�
���savedata
��q%!12<>saveref%:�
file$=�zts(q%+44)
�savedata1
�
* ��savedata1:�closew(w_save%)
4 �savefile(savereason%,file$)
>savereason%=-1:�loadmess
H�
R
\
��prequit
f�altered_at:�ackrec:�qquit
p�
z
�9��ackrec:q%!12=ref%:ș "Wimp_SendMessage",19,q%,task%
�:��qquit:�stop(1,"Lose screen and quit Atelier",as$,-1)
��
�
���enter_atelier
� �:��:��:�restorewimp:��,�$
�#enter%=0:�run_at:�restorewimp:�
�
���savefile(n%,f$)
� �:��:��:�restorewimp:��,�$
�"�save_at(n%,f$):�restorewimp:�
�
���savewimp:�os%=1:�
� wimpsaved% � �
wimpsaved%=�
&�I%,J%:� SYS"Wimp_CommandWindow",1
$�normpoint:mode%=�:�mode15
.
*fx229
8�
B
L��restorewimp:�os%=1:�
V� � wimpsaved% � �
`wimpsaved%=�
j*fx229,1
tș "Wimp_CommandWindow",-1
~Gș "Wimp_SetMode",mode%:�:ș"Wimp_ForceRedraw",-1,-1E9,-1E9,1E9,1E9
��
�
���mode15
��
����:��:�99,"Atelier needs to use MODE 15 and there is not enough RAM! You must use the task manager to make at least 160k of screen available"
� �15:�
�
���findmos:os%=1
��:��:��:�
��+1
�os%=2:�
�
��checkmos:os%=1
�:��:��:�mos12:�
�+1
os%=2:�
(
2��mos12
< �15:�
F
ș &400C0
Penter%=0
Z�run_at
d�12:*desktop
n�
x
���store(� A$,f$)
��I%,C%,T$:T$=f$:�T$>""�
��I%=1��T$:C%=��T$,I%)
�"�C%>64�C%<91�T$,I%,1)=�(C%+32)
��
��
��T$,"$scrap>")=0A$=f$
��
�
�
�G� ----ATELIER BITS-------------------------------------------------
���run_at
�<� ;{{ here, copy the background screen to the foreground
>� ;{{ and do the biz. NB all ERROR traps etc MUST be LOCAL
�savewimp
�normpoint
",� 23,255,255,255,255,255,255,255,255,255
,cat%!0=148
6
cat%!4=-1
@&ș "OS_ReadVduVariables",cat%,cat%
J!topscreen%=!cat%
T�unsetsoftkeys
^ș "OS_RemoveCursors"
h�setvectors
r� undorestore%
|�enter_action
�
� colour%
�� mousecolour%
�� liftdown%
��5:� helptext%
��update
��atelier
�
� liftup%
�� undosave%
��unsetvectors
�� PROCsetsoftkeys
��restorewimp
��
�
��setvectors
� vectors_set% � �
"ș "OS_Claim",&1D,duff_call%,0
&�set_abort_traps
0vectors_set%=�
:�
D
N��unsetvectors
X� � vectors_set% � �
b$ș "OS_Release",&1D,duff_call%,0
l�unset_abort_traps
vvectors_set%=�
��
�
���enter_action
�� � �:�error_at:�
�Ȏ enter% �
��0:� no action,just enter
��1:� compacted load
�
*UnDefine
�*SetPosition 0 1023
�'G%=cat%:$cat%=f$:� com_update_info%
��"PlotFile "+f$
�$enter%=0:�store($screen_str%,f$)
�5�2:$file_str%=f$ :� sprites - handled by atelier
�3:$cat%=f$
G%=cat%
� compactedload%
� undosave%
*enter%=0
4�
>�
H
Rݤaltered_at
\B� ;{{ return TRUE if you would lose any data if they quit just
f>� ;{{ now (ie they have altered screen/sprites/brushes etc
pC� ;{{ since last save/load. Just return FALSE if you don't care
z=� testing
�
�ݤokfile_at(f$,s%,t%)
�I� t%=&D7E � t%=&D3A � t%=&D7F � t%=&D39 � t%=&FF9 � t%=&DE2 � =� � =�
�
���loadfile(f$,s%,t%)
� �:��:��:�restorewimp:��,�$
�%�load_at(f$,s%,t%):�restorewimp:�
�
���load_at(f$,s%,t%)
�Ȏ t% �
��&D7F,&FF9,&DE2
�ș "OS_Find",&40,f$ � hdl%
�ș "OS_GBPB",4,hdl%,cat%,1
ș "OS_Find",&00,hdl%
�
Ȏ t% �
$;�&D7E:�"LOAD "+f$+" "+�~(brush%):�store($brush_str%,f$)
.E�&D3A:�"LOAD "+f$+" "+�~(brpatt%):�store($pattern_str%,f$):!pm%=1
8�&D7F:enter%=1:�run_at
B�&D39:�formula_load(f$)
L2�&FF9:enter%=2:�store($sprite_str%,f$):�run_at
V2�&DE2:enter%=3:�store($screen_str%,f$):�run_at
`�
j�
t
~��save_at(n%,f$)
�� savecheck%
�Ȏ n% �
��0,1,2,3
�=ș "OS_File",&0A,f$,&FFF,,cat%,cat% :� saves dummy file
�
�savewimp
�cat%!0=148:cat%!4=-1
�&ș "OS_ReadVduVariables",cat%,cat%
�+!topscreen%=!cat%:ș "OS_RemoveCursors"
�� undorestore%
�Ȏ n% �
�2�0:�compressedsave(f$):�store($screen_str%,f$)
�0�1:�"SCREENSAVE "+f$:�store($screen_str%,f$)
3�2:�compactedsave(0,f$):�store($screen_str%,f$)
3�3:�compactedsave(1,f$):�store($screen_str%,f$)
�
�restorewimp
(+�4:�"SSAVE "+f$:�store($sprite_str%,f$)
2A�5:�"SAVE "+f$+" "+�~(brush%)+" +2000":�store($brush_str%,f$)
<�"SETTYPE "+f$+" D7E"
FB�6:�"SAVE "+f$+" "+�~(brpatt%)+" +2000":�store($brush_str%,f$)
P�"SETTYPE "+f$+" D3A"
Z�
d�
n
x#��setfile_at(n%,� f$,� s%,� t%)
�A� ;{{ setup up f$ to be filename, s% to estimated size and t%
�2� ;{{ to filetype for file of internal type n%
�3� ;{{ NB s%<0 means unknown size, try it anyway
�Ȏ n% �
�)�0:t%=&DE2:f$=$screen_str% :s%=&28000
�)�1:t%=&FF9:f$=$screen_str% :s%=&28000
�%�2:t%=&D7F:f$=$screen_str% :s%=-1
�%�3:t%=&D7F:f$=$screen_str% :s%=-1
�:�4:t%=&FF9:f$=$sprite_str% :ș "OS_SpriteOp",8�,,,,,s%
�(�5:t%=&D7E:f$=$brush_str% :s%=&2000
�(�6:t%=&D3A:f$=$pattern_str%:s%=&2000
��
��
��animate_sprites
� frame%=0 � 7
"!� colour%:ȓ Ȑ 0,0,1023,1023
,/�"PlotFile AniCreate.Sprites.Frame"+�frame%
6� undosave%
@x1%=0:y1%=0
Jx2%=1023:y2%=1023
Tx3%=0:y3%=0
^x4%=x3%+63:y4%=y3%+127
h$step%=happenstep%:�screen_select
r(�"DefineBuffer "+�(STORE%)+" &28000"
|?�"Com_Save AniCreate.Sprites.Small"+�frame%+" 0 0 63 127 0"
��
��
�
�
��animate
�� frame%=45 � 64
�� !pc%=0 � 255 � 255
�!� colour%:ȓ Ȑ 0,0,1023,1023
�,�"PlotFile ShipSpr.Sprites.Ship"+�frame%
�� undosave%
�x1%=0:y1%=0
�x2%=1023:y2%=1023
�x3%=1024+!pc%�255*96:y3%=0
�x4%=x3%+95:y4%=y3%+191
�$step%=happenstep%:�screen_select
��
(�"DefineBuffer "+�(STORE%)+" &28000"
?�"Com_Save ShipSpr.Small.Ship"+�frame%+" 1024 0 1215 191 0"
�
&�
0
:
��atelier
Dangle=0
N*FX 15,0
X6� ---------MAIN LOOP-----------
b� � � �error_at
l�
v�
�
mrctx1%=0
�
mrcty1%=0
�mrctx2%=1279
�mrcty2%=1023
�
Ȏ !Ac% �
�9�35,36:mrctx1%=32:mrcty1%=32:mrctx2%=1216:mrcty2%=960
�(�24:� step%>2 � �setlimits(xs%,-ys%)
�K�45:mrctx1%=-xs%-xo%:mrcty1%=-ys%-yo%:mrctx2%=1280+xs%:mrcty2%=1024+ys%
�D�71:� step%>2 � mrctx1%=x1%:mrcty1%=y2%:mrctx2%=xs%:mrcty2%=-ys%
�/�75:� step%>2 � mrctx2%-=xs%�2:mrcty2%+=ys%
�a�37,40:� �sprites>0 � � locatesprite%:ș &2E,40,,!sprstr � ,,,xs%,ys%:�setlimits(xs%*2,ys%*4)
��
�)ȗ ȓ mrctx1%,mrcty1%,mrctx2%,mrcty2%
!�mouse_handle
!!� MB=2 � enter% � �menucalled
!AcCODE%=?(!step_codes)
! happenstep%=(AcCODE% � 15)
!*"stepcode%=?(!step_codes+step%)
!4R� (!pm%=2) � (stepcode% � 64) � step%+=1:�copysort:F%=step%:� helpstep%:� �Tja
!>
Ȏ !Ac% �
!H�60,61,62,63,64,65
!RȎ !rect_brush_mode �
!\�0:AcCODE%=AcCODE% � 191
!f*�1:happenstep%+=1:AcCODE%=AcCODE% � 64
!p(� step%=2 � stepcode%=stepcode% � 16
!z+�2:happenstep%+=1:AcCODE%=AcCODE% � 191
!�+� step%=1 � stepcode%=stepcode% � 16+32
!��
!��
!�R� (AcCODE% � 64) � step%=happenstep% � step%=1:�BUTOFF(4):F%=step%:� helpstep%
!�O� � (AcCODE% � 64) � step%=happenstep% � step%=step%-1:F%=step%:� helpstep%
!�
Ȏ � �
!�0�(� (AcCODE% � 64)) � (step%=happenstep%-1):
!�5� (MB � 4)=4 � step%=step%+1:F%=step%:� helpstep%
!�
!�N� � select � � (MB � 4)=(step% � 1)*4 � step%=step%+1:F%=step%:� helpstep%
!�I� select � � (MB � 4) � step%=step%+1:F%=step%:� helpstep%:�BUTOFF(4)
!��
!�
*FX 229,1
"#� step%=happenstep% � *FX 229,0
"inaction=!Ac%
"!� (MB � 1)=1 � �adjustpressed
"$ E%=-1
".� stepcode% � 16 �
"8Ȏ step% �
"B�0,1:C%=MX-x0%:D%=MY-y0%
"L�2,3:C%=MX-x1%:D%=MY-y1%
"V�4,5:C%=MX-x3%:D%=MY-y3%
"`�
"jM� stepcode% � 32 � B%=C%*2:C%=D%:� calc_radius%:C%=!RESULTX/2:E%=2 � E%=0
"t�
"~A%=MX:B%=MY:� help%
"�+� step%=happenstep% � (AcCODE% � 128) �
"�Ȗ
"�
� liftup%
"�
� colour%
"�2� !pm%>0 � (AcCODE% � &20) � � bit_map_scan_A%
"��screen_select
"�3� !pm%>0 � (AcCODE% � &20) � � bit_map_pattern%
"�#� (AcCODE% � 16) � � show_thru%
"�� liftdown%
"��
"�� 3,63 Ȝ 192
"��screen_select
# �
#
.keypress%=�(0):� keypress%>0 � �keypressed
#*� inaction<>!Ac% � �process_new_action
#,� step%<>oldstep% � F%=step%:� helpstep%
#(oldstep%=step%
#2
� !Ac%=20
#<�reset_action
#F
� os%=1 �
#P� testing �
#ZS�errorhandle(3,"Where to Boss","Basic Program|Source Code|Don't Exit",selected)
#d�
#nP�errorhandle(2,"Do you really wish to exit from ATELIER","CONFIRM",selected)
#x�
#�� selected=1
#��
#�)� testing � � selected=1 � selected=2
#�� � testing � � selected=1
#�7� -------------END OF MAIN LOOP ----------
#�� � testing � os%=2 � �
#��tidy_at
#�*FX 15,0
#�Ȏ selected �
#��1:
#�*KEY 4 SAVE|MRUN|M
#�*FX 138,0,69
#�*FX 138,0,68
$*FX 138,0,46
$*FX 138,0,46
$*FX 138,0,13
$"�
$,�2:
$6*KEY 4 RUN|M
$@K�string_to_buffer("LO. ""<Ateli*$Dir>.Sour*.Sou*"""+�(13)+"ED.."+�(13))
$J�
$T�
$^�
$h
$r��adjustpressed
$|� !Ac%=82 � !Ac%=59 �
$��reset_action
$��
$�R� (MB � 1)=1 � step%>1 � step%=step%-1:�BUTOFF(1):�update:F%=step%:� helpstep%
$��
$��
$�
$���reset_action
$�!Ac%=!oldaction%
$��
$�
$���mouse_handle
$�"ȗ MX,MY,MB:� mgs � �mousegrid
$�� !left_handed � Ȏ MB �
%�%001:MB=%100
%�%011:MB=%110
%�%100:MB=%001
%&�%110:MB=%011
%0�
%:� � �(-97) � �
%D2� �(-1) � xrst%=MX:yrst%=MY � ȗ � xrst%,yrst%
%N�
%X
%b� �mousegrid
%l1MX=((MX+mousegrid � 2) � mousegrid)*mousegrid
%v1MY=((MY+mousegrid � 2) � mousegrid)*mousegrid
%�� MX<mrctx1% � MX=mrctx1%
%�� MY<mrcty1% � MY=mrcty1%
%�� MX>mrctx2% � MX=mrctx2%
%�� MY>mrcty2% � MY=mrcty2%
%�Ȓ � MX,MY
%��
%�
%���set_action
%�
Ȏ !Ac% �
%��57,59,82,43
%�
%�!oldaction%=!Ac%
%��
&�
&
&��BUTOFF(M)
& �
&*ȗ DX,DY,MB
&4� !left_handed � Ȏ MB �
&>�%001:MB=%100
&H�%011:MB=%110
&R�%100:MB=%001
&\�%110:MB=%011
&f�
&p� (MB � M)=0
&z�
&�
&���keypressed
&�*FX 15,0
&�Ȏ �(keypress%) �
&��"*":enter%=5
&��
&�� (keypress% � 128)=0 � �
&�Ȏ keypress% �
&�+�&80,&90,&A0,&B0 :� f0-print key
&�
� liftup%
&�� undosave%
&��point(0,0)
&��(funcprint$)
'!� �<>15 � � 15:� undorestore%
'�update
'� liftdown%
'$�&B1
'.� undosave%
'8
*FX229
'B� 0
'L�2
'V� !Ac%=0 � 82
'`!rect_brush_mode=(!Ac% � 3)
'j�"Function ";!Ac%
't�
'~� helptext%
'��
'��
'��3
'�� 15
'�� undorestore%
'�9�&81,&91,&A1,&B1:� liftup%:� undorestore%:� liftdown%
'�0�&82,&92,&A2,&B2:step%=1:�set_action:!Ac%=57
'�`�&83,&93,&A3,&B3:� !Ac%<>82 � step%=1:�set_action:!Ac%=82 � !brushsel%=((!brushsel%+1) � 15)
'�:�&84,&94,&A4,&B4:!pm%=0:!pc%=�MX,MY)+Ȝ(MX,MY):�update
'��&85,&95,&A5,&B5
'�O� !helpstatus% � � helpon%:�5:� helptext%:F%=step%:� helpstep% � � helpoff%
'��&86,&96,&A6,&B6
( mgs=1-mgs:�update
(
�&87,&97,&A7,&B7
(� testing � keypress%=&A7 �
(
*FX229
(("� liftup%:�animate:� liftdown%
(2�
(<
� liftup%
(F� undosave%
(P� liftdown%
(Z�
(d�&88,&98,&A8,&B8
(nC� (testing � keypress%=&88) � (� testing) � �set_action:!Ac%=20
(x-� testing � keypress%=&98 � os%=1:!Ac%=20
(�^� testing � keypress%=&A8 � � liftup%:A%=!presentmenu%:G%=MX:H%=MY:� drawmenu%:� liftdown%
(��
(�keyin%=(keypress%�&F)-9
(�� keyin%>4 � keyin%=-1
(�� keyin%>-1 �
(�&keylevel%=(((keypress%�&F0)>>4)�4)
(�Y� �(-3) � function%(keyin%,keylevel%)=!Ac% � !Ac%=function%(keyin%,keylevel%):�update
(��
(��
(�
(���process_new_action
(�� !Ac%=33 � �reset_action
(�3�5:� helptext%:F%=1:� helpstep%:step%=1:�update
)�
)
)��menucalled
)"�set_action
),ȗ ȓ 0,0,1279,1023
)6
� liftup%
)@!mousebuts=0
)J.� ?(!actionsave)<255 � ?(!actionsave)=!Ac%
)T-� 128+(BACKCOL% � 63) Ȝ (BACKCOL% � 192)
)^Ȏ enter% �
)h!�2:A%=7:� downtree%:� sprites
)r �5:A%=28:� downtree%:� oscli
)|�
)�&� enter%=4 � !Ac%=12 � A%=9 � A%=0
)�ȗ MX,MY,MB
)�G%=MX:H%=MY:� menusystem%
)�� !Ac%=33 � �reset_action
)�step%=1:�update:�BUTOFF(7)
)�� !Ac%<>43 �
)�� liftdown%
)��5:� helptext%
)�F%=step%:� helpstep%
)��
)�5� ?(!actionsave)<255 � !oldaction%=?(!actionsave)
)�enter%=0
)��
*
*��initerror
*� �=15 � � 0
*&� 7
*0� �=17 � �"Escaped!":�
*:�$;" at line ";�
*D� � testing � �
*N*FX 15,0
*XA=�
*b(�string_to_buffer("ED. "+�(�)+�(13))
*l�
*v�
*�
*���string_to_buffer(tran$)
*��
*� �"FX 138,0,"+�(�(�tran$,1)))
*�tran$=�tran$,2)
*�� tran$=""
*��
*�
*�
��tidy_at
*��setsoftkeys
*��unsetvectors
*��
*�
+��unsetsoftkeys
+$� R=221 � 228:�"FX "+�(R)+",2":�
+
*FX 219,9
+ �
+*
+4��setsoftkeys
+>$� R=221 � 228:�"FX "+�(R)+",1":�
+H
*FX 219,9
+R�
+\
+f
��init_at
+p � testing � � � � �initerror
+z ��Dfk
+�6PNglass=2:PNbrush=3:PNflood=4:PNpencil=5:PNspray=6
+�MPNnormal=7:PNspriteop=8:PNcalculator=14:PNkeyboard=15:PNA=16:PNstopped=17
+�PNquestion=18:PNhand=19
+�5com_gx1%=0:com_gy1%=0:com_gx2%=1278:com_gy2%=1020
+��unsetsoftkeys:K=1024
+��� BLOW% 1*K,STORE% 160*K,cat% 1*K,brush% 8*K,brpatt% 8*K,cycle% 128,file_icons% 3*K,log_table% 256,log_scale% 1040,formnames% 1*K,fontlist% 1*K
+��� skel% 1764*10,sqr% &5201,sin% 360*4,tan% 90*4,numbers% &720,screen_str% 256,pattern_str% 256,brush_str% 256,sprite_str% 256,file_str% 256
+ʏ� behind% 256,flags% 4,PO% &14DC,sprstr% 30,fontstr% 45,presentfont% 80,xget% 800,yget% 800,BUFF% 1*K,BUFFER% 35328,freetable% 256,abts% 16
+�=� L(640),A%(641,1),B%(256,1),function%(4,3),formulas$(10)
+�$�"LOAD "+�dir+"POINTER "+�~(PO%)
+�� os%=1 � �point(0,1)
+�$s%=�(�dir+"code*"):sz%=�#s%:�#s%
+�0� code% sz%:�"LOAD "+�dir+"code* "+�~(code%)
,pl$="LOAD "+�dir
,�pl$+"!Brushes "+�~(brush%)
,!�pl$+"!Patterns "+�~(brpatt%)
,$#*Com_Open <Atelier$Dir>.Sprites
,.�in(file_icons%,"40 8")
,8�in(numbers%,"12 8")
,B�in(BUFFER%,"384 92")
,L*Com_Close
,V
�codevars
,`� os%=1 � �point(0,0)
,j$screen_str%="Screen"
,t$pattern_str%="Patterns"
,~$brush_str%="Brushes"
,�$sprite_str%="SpriteFile"
,�$sprstr%="new_sprite"
,�g_sprite$="new_sprite"
,�cycle%!0=16
,�
� R=0 � 3
,�� o%
,�� R1=0 � 3
,�!(cycle%+R*16+R1*4+4)=o%+R1
,��:�
,�"� R=0 � 255:?(behind%+R)=255:�
,�U� R=1 � 256:?(log_table%+R-1)=20+(R^2)/300:�:� R=0 � 5248:!(sqr%+R*4)=�(R*1024):�
,�)� R=0 � 359:!(sin%+R*4)=��(R)*65536:�
- (� R=0 � 89:!(tan%+R*4)=��(R)*65536:�
-
� 0,44,208,252
-%� 4,364,408,584,224,584,72,456,72
-
� numlist
-(!bolpoint%=numlist
-2� R=0 � !bolpoint%-1
-< � X,Y
-F#!(xget%+R*4)=X:!(yget%+R*4)=Y+4
-P�
-Z?(flags%)=255
-d?(flags%+1)=255
-n?(flags%+2)=255
-x?(flags%+3)=255
-�!sprstr=sprstr%
-�!brpatt=brpatt%
-�!flags=flags%
-�
!cat=cat%
-�!behind=behind%
-�!brushshapes=brush%
-�!BUFF=BUFF%
-�
!FLOB=PO%
-�!bolx=xget%
-�!boly=yget%
-�!fontstr=fontstr%
-�!presentfont=presentfont%
-�!STORE=STORE%
.!freetable=freetable%
.!put=BUFFER%
.!cycle=cycle%
."!screen_str=screen_str%
.,!pattern_str=pattern_str%
.6!brush_str=brush_str%
.@!sprite_str=sprite_str%
.J!file_icons=file_icons%
.T!log_table=log_table%
.^!log_scale=log_scale%
.h!numbers=numbers%
.r
!sqr=sqr%
.|
!sin=sin%
.�
!tan=tan%
.�!file_str=file_str%
.�!formnames=formnames%
.�!skel=skel%
.�!fontlist=fontlist%
.�2*IF "<Font$Prefix>"="" THEN *SET Font$Prefix $
.�� �
.�8� � � $fontlist%="Font Disk Not Present"+�(0):� �djn
.�A%=testing
.�� initialisation%
.�� �
.��checkdumper
.�xrst%=640:yrst%=512
/x0%=0:y0%=0:x1%=0:y1%=0
/x2%=0:y2%=0:x3%=0:y3%=0
/x4%=0:y4%=0:x5%=0:y5%=0
/& actionflags%=8:actionstep%=3
/0xs%=0:ys%=0:oldstep%=0
/:step%=1:vectors_set%=�
/Dwedge%=0:col%=0
/Npsizex%=160:psizey%=160
/Xxpsize%=-1:ypsize%=-1
/bmgs=�:mcs=�
/lmousegrid=32:select=�
/vP%=formnames%
/�
[OPT 0
/�
EQUB 1
/�EQUB 10
/�EQUS "Defineable"
/�]
/�formula$="SIN(YR)*50"
/�$dummy=�build_formula(formula$,0)
/�botrad$="1"
/�(atext$="Atelier (C) Simon Clay 1989"
/��removekeymod
/�funcprint$="BYE"
/�eval$=""
/�!oldaction%=60
0�
0
0
0 ��in(b%,s$)
0*"�"Com_Sprites $ "+�(b%)+" "+s$
04�
0>
0H��removekeymod
0R� �
0\� � � �
0f!*Unplug InternationalKeyboard
0p�
0z
0���set_abort_traps
0�abts%!0=!&C
0�abts%!4=!&10
0�abts%!8=!&14
0�� PASS=0 � 2 � 2
0� P%=&C
0�
[OPT PASS
0�<B abt1% ;sets abort on instuction fetch error trap
0�9B abt2% ;sets abort on data transfer error trap
0�4B abt3% ;sets address exception error trap
0�]�
0��
0�
1��unset_abort_traps
1!&0C=abts%!0
1!&10=abts%!4
1$!&14=abts%!8
1.�
18
1B��codevars
1L
1Vvariablelocate%=code%+4*1
1`com_put%=code%+4*2
1jlocatesprite%=code%+4*3
1thelp%=code%+4*4
1~helpon%=code%+4*5
1�helpoff%=code%+4*6
1�helpstep%=code%+4*7
1�helptext%=code%+4*8
1�liftup%=code%+4*9
1�liftdown%=code%+4*10
1�colour%=code%+4*11
1�undorestore%=code%+4*12
1�undosave%=code%+4*13
1�drawmenu%=code%+4*14
1�menusystem%=code%+4*15
1�mousecolour%=code%+4*16
1�screen_select%=code%+4*17
2 spriteinit%=code%+4*18
2
magnify%=code%+4*19
2uptree%=code%+4*20
2putbackground%=code%+4*21
2(com_get%=code%+4*22
22"putscreenrectangle%=code%+4*23
2<brusheor%=code%+4*24
2Fbrushdraw%=code%+4*25
2Pbrushundo%=code%+4*26
2Zspritepix%=code%+4*27
2dbrushget%=code%+4*28
2nshapeget%=code%+4*29
2xspriteputerror%=code%+4*30
2�#getspritefromscreen%=code%+4*31
2�priorityin%=code%+4*32
2�undochar%=code%+4*33
2�undobox%=code%+4*34
2�scanscreen%=code%+4*35
2�colourbyte%=code%+4*36
2�calc_intensity%=code%+4*37
2�splodgeread%=code%+4*38
2�setbord%=code%+4*39
2�abt1%=code%+4*40
2�FINDMENU%=code%+4*41
2�SKIPWORD%=code%+4*42
2�drawword%=code%+4*43
3abt2%=code%+4*44
3abt3%=code%+4*45
3COLaverage%=code%+4*46
3"COLgcol%=code%+4*47
3,"COLmode15_13resize%=code%+4*48
36show_thru%=code%+4*49
3@swap_pixels%=code%+4*50
3J#COLsmooth_rectangle%=code%+4*51
3Tcompactedsave%=code%+4*52
3^screensave%=code%+4*53
3hbit_map_scan_A%=code%+4*54
3rbit_map_scan_B%=code%+4*55
3|bit_map_pattern%=code%+4*56
3�vertical_fill%=code%+4*57
3�copy_fill%=code%+4*58
3�calc_radius%=code%+4*59
3�framedraw%=code%+4*60
3�spin_bottle%=code%+4*61
3�translate_point%=code%+4*62
3�#anti_aliased_squash%=code%+4*63
3�screenload%=code%+4*64
3�initialisation%=code%+4*65
3�formframedraw%=code%+4*66
3�form_translate%=code%+4*67
3�convertmode%=code%+4*68
3�bytecolour%=code%+4*69
4downtree%=code%+4*70
4checksprites%=code%+4*71
4compactedload%=code%+4*72
4&savecheck%=code%+4*73
40fontlistinit%=code%+4*74
4:duff_call%=code%+4*75
4Ddraw_error_box%=code%+4*76
4Ncom_update_info%=code%+4*77
4X
4b�variablelocate%
4l
4vc=!code%
4�
4�
Ac%=c+4*0
4�printmenu%=c+4*1
4�
pc%=c+4*2
4�brushsel%=c+4*3
4�helpstatus%=c+4*4
4�presentmenu%=c+4*5
4�bolpoint%=c+4*6
4�topscreen%=c+4*7
4�blowcol%=c+4*8
4�YES%=c+4*9
4�putit%=c+4*10
4�sprsel%=c+4*11
5startx%=c+4*12
5starty%=c+4*13
5compaction%=c+4*14
5 sprpos=c+4*15
5*freecol=c+4*16
54OUT=c+4*17
5>limtop=c+4*18
5Hlimbot=c+4*19
5Rstart=c+4*20
5\hlength=c+4*21
5fRESULTX=c+4*22
5pRESULTY=c+4*23
5zlastmenu=c+4*24
5�r1store=c+4*25
5�r0store=c+4*26
5�left_handed=c+4*27
5�compact3x4=c+4*28
5�inlaysed=c+4*29
5�sprstr=c+4*30
5�brpatt=c+4*31
5�flags=c+4*32
5�cat=c+4*33
5�behind=c+4*34
5�brushshapes=c+4*35
5�BUFF=c+4*36
5�FLOB=c+4*37
6bolx=c+4*38
6boly=c+4*39
6fontstr=c+4*40
6$presentfont=c+4*41
6.STORE=c+4*42
68freetable=c+4*43
6Bput=c+4*44
6Lcycle=c+4*45
6Vrect_brush=c+4*46
6`screen_str=c+4*47
6jpattern_str=c+4*48
6tbrush_str=c+4*49
6~sprite_str=c+4*50
6�help_text_data=c+4*51
6�file_icons=c+4*52
6�bit_map=c+4*53
6�fillstylepic=c+4*54
6�log_table=c+4*55
6�log_scale=c+4*56
6�
6�numbers=c+4*58
6�magnify_xpos=c+4*59
6�magnify_ypos=c+4*60
6�putpos=c+4*61
6�magputpos=c+4*62
7 sizex=c+4*63
7
sizey=c+4*64
7sprsize=c+4*65
7spritex=c+4*66
7(spritey=c+4*67
72gtspritex=c+4*68
7<gtspritey=c+4*69
7Fdiskfontlistposition=c+4*70
7Pcatpos=c+4*71
7Zfontsel=c+4*72
7dpattsel=c+4*73
7ntreepos=c+4*74
7xmatrixput=c+4*75
7�barval_red=c+4*76
7�barval_grn=c+4*77
7�barval_blu=c+4*78
7�scaleval_left=c+4*79
7�scaleval_right=c+4*80
7�cycleplace=c+4*81
7�cycledirection=c+4*82
7�cyclemode=c+4*83
7�pm%=c+4*84
7�mixval_red=c+4*85
7�mixval_grn=c+4*86
7�mixval_blu=c+4*87
7�mousex=c+4*88
8mousey=c+4*89
8mousebuts=c+4*90
8magnification=c+4*91
8"magnify_xget=c+4*92
8,magnify_yget=c+4*93
86magnify_status=c+4*94
8@HANG=c+4*95
8Jrect_brush_mode=c+4*96
8Tvacant=c+4*97
8^com_x1=c+4*98
8hcom_y1=c+4*99
8rcom_x2=c+4*100
8|com_y2=c+4*101
8�sprint_xsize=c+4*102
8�sprint_ysize=c+4*103
8�spritemask=c+4*104
8�fill_style=c+4*105
8�fill_prop=c+4*106
8�fill_logr=c+4*107
8�fill_dith=c+4*108
8�step_codes=c+4*109
8�border=c+4*110
8�sqr=c+4*111
8�actionsave=c+4*112
8�bottle=c+4*113
8�bot_tilt=c+4*114
9bot_lean=c+4*115
9bot_xout=c+4*116
9bot_yout=c+4*117
9&line_selected=c+4*118
90bot_finish=c+4*119
9:bot_xscale=c+4*120
9Dbot_yscale=c+4*121
9Nhangdelay=c+4*122
9Xsin=c+4*123
9btan=c+4*124
9lfile_str=c+4*125
9vform=c+4*126
9�tilt=c+4*127
9�lean=c+4*128
9�rotation=c+4*129
9�xscale=c+4*130
9�yscale=c+4*131
9�hscale=c+4*132
9�form_list_pos=c+4*133
9�formnames=c+4*134
9�formula=c+4*135
9�skel=c+4*136
9�shade_range=c+4*137
9�min_shade=c+4*138
9�fontlist=c+4*139
:oldaction%=c+4*140
:
:
: BORDSIZE=28
:*WEDGESIZE=16
:4textcol%=0
:>BACKCOL%=202
:HTITLECOL%=0
:RBORDERCOL%=74
:\BORD1%=207
:f
BORD2%=15
:pBORD3%=138
:zBORD4%=197
:�DIRECTORYCOL%=224
:�
:��
:�
:���screen_select
:�
:�#� (!Ac%=1 � !Ac%=2) � step%=3 �
:��
:��mouse_handle
:�7D%=!Ac%:E%=step%:F%=MB:G%=MX:H%=MY:� screen_select%
:�
� MB=0
:�� !Ac%=1 � x1%=MX:y1%=MY
:��
;7D%=!Ac%:E%=step%:F%=MB:G%=MX:H%=MY:� screen_select%
;�
;
� !YES% �
;$Ȏ step% �
;.�1:x1%=MX:y1%=MY
;8�2:x2%=MX:y2%=MY
;B�3:x3%=MX:y3%=MY
;L�4:x4%=MX:y4%=MY
;V�5:x5%=MX:y5%=MY
;`�
;j�
;t� !YES% � �
;~
;�
;�Ȏ (!Ac%) �
;�
;�
� Magnify
;��12:Ȏ step% �
;��2:enter%=4
;�!magnify_xpos=MX � 2
;�!magnify_ypos=255-(MY � 4)
;��
;�
;�
� Fill
;��13:Ȏ step% �
<