gSort1400 Front End
I wrote the multitasking front end of gSort1400 as a RISC OS 3 application (circa 1992) to make things more interesting. All of the operating system calls are handled by hand. This is my first (and probably last) RISC OS Application.
|
REM gSort front end v0.1 (c) Rob Geleit September 2007
DIM space 256,menu_space 512
DIM LIMITmenu_space 128,LIMITspace 6,LIMITvalid 12
DIM icon0 6
DIM co_name 256
DIM header_text 256
DIM info_window_space 2048,info_indirected_space 2048
DIM main_window_space 4096,main_indirected_space 2048
DIM message_list 128
DIM icon_space 2048, icon2_space 2048
DIM string 256
DIM leaf_space 256
DIM weight 24
REM$weight="122"
DIM icon1space 20, icon1valid 20
DIM formenu_space 256,classmenu_space 256
DIM icon_class 4
DIM icon_format 16
DIM ref_text 256
DIM errorstring_exp 256
DIM space% 256, error_block 256
task=&4B534154
vers=310
!message_list=3
message_list!4=0
currentmenu=0
use_ramdisk=TRUE
folder$=""
leaf$=""
PROCinit
PROCload_windows
PROCmenu1
PROCmenu2
PROCmenu3
PROCmenu4
PROCloadsettings
quit=FALSE
REPEAT
SYS"Wimp_Poll",1,space TO event_code,event_block:REM &1831
CASE event_code OF
WHEN 2:SYS"Wimp_OpenWindow",,event_block
WHEN 3:SYS"Wimp_CloseWindow",,event_block
WHEN 6:PROCbutton(!event_block,event_block!4,event_block!8,event_block!12,event_block!16)
WHEN 9:PROCmenu_click(event_block)
WHEN 17:PROCuser_message(event_block!16)
WHEN 18:PROCuser_message(event_block!16)
ENDCASE
UNTIL quit=TRUE
SYS"Wimp_CloseDown",handle,task
END
DEF PROCinit
SYS"Wimp_Initialise",vers,task,"gSort1400",message_list TO,handle
space!0=-1
space!4=0
space!8=0
space!12=68
space!16=68
space!20=&301A
$(space+24)="!gSort1400"
SYS "Wimp_CreateIcon",,space TO icon
$LIMITspace="0"
$LIMITvalid="A0-9"
ENDPROC
DEF PROCmenu1
LOCAL T%
FOR T%=0TO2 STEP2
P%=menu_space
[OPTT%
ALIGN
.menu1 EQUS "gSort1400"+CHR$0
EQUW 0
ALIGN
EQUB 7
EQUB 2
EQUB 7
EQUB 0
EQUD 200
EQUD 40
EQUD 0
EQUD %00000000
EQUD info_window
EQUD &07000039
EQUS "Info "+CHR$0
EQUD %10000000
EQUD -1
EQUD &07000039
EQUS "Quit "+CHR$0
]
NEXT
ENDPROC
DEF PROCmenu2
LOCAL T%
FOR T%=0TO2 STEP2
P%=LIMITmenu_space
[OPTT%
ALIGN
.menu2 EQUS "Limit"+CHR$0:EQUB0:EQUB0
EQUD 0
ALIGN
EQUB 7
EQUB 2
EQUB 7
EQUB 0
EQUD 100
EQUD 40
EQUD 0
EQUD %00000000
EQUD -1
EQUD &07000019
EQUS "25"+CHR$0:EQUD0:EQUD0:ALIGN
EQUD %00000000
EQUD -1
EQUD &07000019
EQUS "5"+CHR$0:EQUD0:EQUD0:ALIGN
EQUD %10000100
EQUD -1
EQUD &07000119
EQUD LIMITspace
EQUD LIMITvalid
EQUD 6
]
NEXT
ENDPROC
DEF PROCmenu3
LOCAL T%
FOR T%=0TO2 STEP2
P%=classmenu_space
[OPTT%
ALIGN
.menu3 EQUS "Class"+CHR$0:EQUB0:EQUB0
EQUD 0
ALIGN
EQUB 7
EQUB 2
EQUB 7
EQUB 0
EQUD 100
EQUD 40
EQUD 0
EQUD %00000000
EQUD -1
EQUD &07400019
EQUS "1"+CHR$0:EQUW0:EQUD0:EQUD0
EQUD %00000000
EQUD -1
EQUD &07000019
EQUS "2"+CHR$0:EQUW0:EQUD0:EQUD0
EQUD %10000000
EQUD -1
EQUD &07000019
EQUS "3"+CHR$0:EQUW0:EQUD0:EQUD0
]
NEXT
ENDPROC
DEF PROCmenu4
LOCAL T%
FOR T%=0TO2 STEP2
P%=formenu_space
[OPTT%
ALIGN
.menu4 EQUS "Format"+CHR$0:EQUB0:EQUD0
EQUB 7
EQUB 2
EQUB 7
EQUB 0
EQUD 100
EQUD 40
EQUD 0
EQUD %00000000
EQUD -1
EQUD &07000011
EQUS "Letter "+CHR$0
EQUD %00000000
EQUD -1
EQUD &07000011
EQUS "Large Letter"
EQUD %00000000
EQUD -1
EQUD &07000011
EQUS "A3 Packet "+CHR$0
EQUD %10000000
EQUD -1
EQUD &07000011
EQUS "Packet "+CHR$0
]
NEXT
ENDPROC
DEF PROCbutton(X%,Y%,press,windowid,iconid)
IF windowid=-2 THEN
IF iconid=icon THEN
IF press AND 2 THEN PROCmenu
IF press AND 4 THEN PROCselect
ENDIF
ENDIF
IF windowid=main_window THEN
CASE iconid OF
WHEN 2: PROCprocess
WHEN 3: PROCLIMITmenu
WHEN 11: use_ramdisk=NOT(use_ramdisk)
WHEN 12: PROCsavesettings
WHEN 16: !space=main_window:SYS"Wimp_CloseWindow",,space
WHEN 23: PROCclassmenu
WHEN 24: PROCformenu
ENDCASE
ENDIF
ENDPROC
DEF PROCmenu
SYS"Wimp_CreateMenu",,menu1,X%-100,176
currentmenu=0
ENDPROC
DEF PROCLIMITmenu
currentmenu=1
SYS"Wimp_CreateMenu",,menu2,X%,Y%
ENDPROC
DEF PROCclassmenu
currentmenu=2
SYS"Wimp_CreateMenu",,menu3,X%,Y%
ENDPROC
DEF PROCformenu
currentmenu=3
SYS"Wimp_CreateMenu",,menu4,X%,Y%
ENDPROC
DEF PROCselect
!space=main_window
space!4=1024
space!8=1024
space!12=1024
space!16=1024
space!20=786
space!24=786
space!28=-1
SYS"Wimp_OpenWindow",,space
ENDPROC
DEF PROCuser_message(message)
CASE message OF
WHEN 0:quit=TRUE
WHEN 3:PROCdata_load
ENDCASE
ENDPROC
DEF PROCmenu_click(menu_struct)
LOCAL menu1
menu1=!menu_struct
IF currentmenu=0 THEN
IF menu1<>-1 THEN
CASE menu1 OF
WHEN 0:REM info
WHEN 1:quit=TRUE:REM quit
ENDCASE
ENDIF
ENDIF
IF currentmenu=1 THEN
IF menu1<>-1 THEN
CASE menu1 OF
WHEN 0:$icon0="25"
WHEN 1:$icon0="5"
WHEN 2:$icon0=$LIMITspace
ENDCASE
ENDIF
PROCredrawicon(0)
ENDIF
IF currentmenu=2 THEN
IF menu1<>-1 THEN
CASE menu1 OF
WHEN 0:$icon_class="1"
WHEN 1:$icon_class="2"
WHEN 2:$icon_class="3"
ENDCASE
ENDIF
PROCredrawicon(14)
ENDIF
IF currentmenu=3 THEN
IF menu1<>-1 THEN
CASE menu1 OF
WHEN 0:$icon_format="Letter"
WHEN 1:$icon_format="Large Letter"
WHEN 2:$icon_format="A3 Packet"
WHEN 3:$icon_format="Packet"
ENDCASE
ENDIF
PROCredrawicon(15)
ENDIF
ENDPROC
DEF PROCload_windows
$space="ProgInfo"
SYS"Wimp_OpenTemplate",,"<gSort$Dir>.Templates"
SYS"Wimp_LoadTemplate",,info_window_space,info_indirected_space,info_indirected_space+2048,-1,space,0 TO ,,next,,,,nextpos
$space="BSAnchor"
SYS"Wimp_LoadTemplate",,main_window_space,main_indirected_space,main_indirected_space+2048,-1,space,0
SYS"Wimp_CloseTemplate"
main_window_space!236=leaf_space
$leaf_space="Drop Folder Here"
main_window_space!140=icon1space
main_window_space!144=icon1valid
$icon1valid="A0-9"
main_window_space!108=icon0
main_window_space!396=header_text
main_window_space!428=co_name
main_window_space!524=ref_text
$ref_text="Hello!"
main_window_space!556=icon_class
$icon_class="5"
main_window_space!588=icon_format
$icon_format="Poot"
main_window_space!684=weight
main_window_space!688=icon1valid
main_window_space!692=16
SYS"Wimp_CreateWindow",,info_window_space TO info_window
SYS"Wimp_CreateWindow",,main_window_space TO main_window
ENDPROC
DEF PROCprocess
LOCAL file%,processed%,a%,o%,s%,error$
processed%=TRUE
IF VAL($weight)*VAL($icon1space)>11000 PROCerrorbox(3,"Warning: Weight x Quantity is greter than 11Kg")
IF folder$="" THEN
PROCerrorbox(1,"Drag a work folder containing an ""addresses"" file to the Drop Folder box.")
processed%=FALSE
ELSE
SYS"Hourglass_On"
file%=OPENOUT(folder$+".gSortData")
PRINT#file%,$icon1space,$icon0,$header_text,$co_name,$weight,$ref_text,$icon_class,$icon_format
CLOSE#file%
OSCLI("set gSortTarget$Path "+folder$+".")
IF use_ramdisk=TRUE THEN OSCLI("set gSortTemp$Path RAM::RamDisc0.$.") ELSE OSCLI("set gSortTemp$Path <gSort$Dir>.Temp.")
OSCLI("wimpslot -next 8320k")
SYS"Hourglass_LEDs",1,0
OSCLI("set gSort$Error Fatal")
REM*fx200,1
SYS"Wimp_StartTask","<gSort$Dir>.sort -l"+$icon0+" -w"+$weight+" -m"+$icon1space+" ""-h"+$header_text+""" ""-n"+$co_name+""" ""-j"+$ref_text+""" ""-s"+$icon_class+""" ""-f"+$icon_format+""""
*fx200,0
error$=FNvar_expand("gSort$Error")
IF error$="Fatal" PROCerrorbox(3,"gSort1400 encountered an unexplained error. If you get a Checksum Error next time you run, simply run gSort1400 a second time (beta)."):processed%=FALSE:quit=TRUE
IF error$<>"Fatal" AND error$<>"None" PROCerrorbox(4,"Error: "+error$+"."):processed%=FALSE
ENDIF
IF processed%=TRUE THEN
SYS"Hourglass_LEDs",0,0
o%=FNcountlines("<gSortTarget$path>outfile")
s%=FNcountlines("<gSortTarget$path>linelist")
a%=FNcountlines("<gSortTarget$path>addresses")
IF a%+s%-o%<>7 PROCerrorbox(2,"Checksum error!")
SYS"Hourglass_Off"
ENDIF
ENDPROC
DEF FNcountlines(file$)
LOCAL file%,T%,c%
T%=0
file%=OPENIN(file$)
IF file%<>0 THEN
REPEAT
c%=BGET#file%
IF c%=10 THEN T%=T%+1
UNTIL EOF#file%
CLOSE#file%
ENDIF
=T%
DEF PROCdata_load
LOCAL T%,D%,I%,file%
IF event_block!20=main_window AND event_block!24=4 AND event_block!40=&1000 THEN
T%=event_block+43
D%=T%+1
REPEAT
T%+=1
IF?T%=ASC(".") D%=T%
UNTIL?T%=0
?T%=13
folder$=$(event_block+44)
leaf$=$(D%+1)
file%=OPENIN(folder$+".addresses")
IF file%<>0 THEN
$leaf_space=leaf$
PROCredrawicon(4)
CLOSE #file%
ELSE
PROCerrorbox(0,"No addresses file in work folder.")
ENDIF
file%=OPENIN(folder$+".gSortData")
IF file%<>0 THEN
INPUT#file%,$icon1space,$icon0,$header_text,$co_name,$weight,$ref_text,$icon_class,$icon_format
CLOSE#file%
PROCredrawicon(1)
PROCredrawicon(0)
PROCredrawicon(9)
PROCredrawicon(10)
PROCredrawicon(13)
PROCredrawicon(14)
PROCredrawicon(15)
PROCredrawicon(18)
ENDIF
ENDIF
ENDPROC
DEF PROCsavesettings
LOCAL defaults%
defaults%=OPENOUT("<gSort$Dir>.defaults")
PRINT#defaults%,$icon1space,$icon0,$header_text,$co_name,$weight,$ref_text,$icon_class,$icon_format
CLOSE#defaults%
ENDPROC
DEF PROCloadsettings
defaults%=OPENIN("<gSort$Dir>.defaults")
INPUT#defaults%,$icon1space,$icon0,$header_text,$co_name,$weight,$ref_text,$icon_class,$icon_format
CLOSE#defaults%
ENDPROC
DEF PROCredrawicon(icon%)
!space%=main_window
space%!4=icon%
space%!8=0
space%!12=0
SYS"Wimp_SetIconState",,space%
ENDPROC
DEF FNvar_expand(V$)
SYS"XOS_ReadVarVal",V$,errorstring_exp,-1 TO ,,R2
SYS"OS_ReadVarVal",V$,errorstring_exp,255
errorstring_exp?(-R2-1)=13
=$errorstring_exp
DEF PROCerrorbox(errno,text$)
!error_block=errno
$(error_block+4)=text$+CHR$0
SYS"Wimp_ReportError",error_block,&1,"gSort"+CHR$0
ENDPROC