!RunImage for Sprite 2 Jpeg
 David Rodgman '95
 Freeware !
 See Help file for details
$+" at line "+
ONERROR PROCerror("Error from Sprite 2 Jpeg",%11,REPORT$+" at line "+STR$ERL,1)
 "WimpExt_PrePoll"
 "Wimp_Poll",,q% 
 reason%
 "WimpExt_Action",s2jpeg%,q%,reason% 
 reason%
 reason% 
 "WimpExt_AutoRedraw",,q%
 "WimpExt_OpenLinked",,q%
 "WimpExt_CloseLinked",,q%:
 !q%=save% 
empty_scrap
click
drag_end
 !q%=innards% 
 q%!24=13 
 "WimpExt_SlabIcon",,,options%,2:sl%=-1 
 "Wimp_ProcessKey",q%!24:sl%=-1
menu_sel
 17,18,19:
recieve
 sl% 
 q%!12=options%:q%!16=2:sl%=
click
 quit%=
empty_scrap
*Unset S2J$Dir
 "WimpExt_CloseDown",s2jpeg%
 "Wimp_CloseDown"
click
slab%=q%!16
 q%!12 
 info%:
 q%!16=2 
author
 q%!16=iconbar% 
icon_click
 save%:
save_click
 options%:
options
 innards%:
innards
SYS "XWimpExt_SlabIcon",,,0,slab%,0
author
 "WimpExt_GetIcon",,,info%,2 
 ,,,t%:t$=
string(t%,-1)
t$,5)="David" 
 t$="The Intelligent Stoat" 
 t$="David Rodgman"
 "WimpExt_SetIconString",0,,info%,2,t$
icon_click
 q%!8=2 
 "WimpExt_CreateMenu",,main_menu%,!q%-64,96+44*2:menu%=main_menu%
set_vars:!q%=options%
 "Wimp_GetWindowState",,q%
 "WimpExt_OpenLinked",,q%
 "WimpExt_PutCaretIcon",,,innards%,4
options
 q%!8=2 
 q%!8<>1 
 !q%=options%:
 "WimpExt_CloseLinked",,q%
 q%!16 
set_vars
read_vars:
save_options
read_vars
innards
menu_sel
 menu% 
 main_menu%
 !q% 
 1:quit%=
 type_menu%
 item%=!q%
type_tick(type_tick%,0)
type_tick(item%,1)
 type_tick%=item%
type_tick(item%,tick%)
 tick%=0 
Z<type_menu%!(28+24*item%)=type_menu%!(28+24*item%) 
\9type_menu%!(28+24*item%)=type_menu%!(28+24*item%) 
 tick%=1 
 item%<6 
 item% 
 1:t$="file_690":i$="Clear"
 2:t$="file_ff9":i$="8-bit Sprite"
 3:t$="file_ff9":i$="24-bit Sprite"
 4:t$="file_695":i$="GIF"
 5:t$="file_69d":i$="Targa"
outspr$=t$
g#t$="S"+t$+";wpptr_hand,6,1"+
h/!q%=save%:q%!4=3:
 "Wimp_GetIconState",,q%
$(q%!32)=t$:q%!8=0:q%!12=0
 "Wimp_SetIconState",,q%
k/!q%=save%:q%!4=4:
 "Wimp_GetIconState",,q%
$(q%!28)=i$:q%!8=0:q%!12=0
 "Wimp_SetIconState",,q%
recieve
 i%:i%=q%!16:
 0:quit%=
save_to_disc
load_from_disc
 **** Filing routines
empty_scrap
SYS "OS_FSControl",9,"<Wimp$ScrapDir>.S2Jpeg" TO ,,,,size%
IF size%<=10240 THEN ENDPROC:REM 10k is not worth the hassle
 "XOS_CLI","Wipe <Wimp$ScrapDir>.S2Jpeg ~CF~VR"
 "XOS_CLI","CDir <Wimp$ScrapDir>.S2Jpeg"
load_from_disc
err_click%=0
&sender%=q%!4:
 sender%=s2jpeg% 
;type%=q%!40:
 type%<>&FF9 
 type%<>&690 
 type%<>&C85 
error("Message from Sprite 2 Jpeg",%011,"This does not look like an image file - continue ?",0)
 err_click%=1 
!fn$=
string(q%+44,-1):in$=fn$
4!q%=256:q%!16=4:
 "Wimp_SendMessage",17,q%,q%!4
 type% 
 &FF9,&690:dodgy%=
:outspr$="file_c85":
cjpeg
 &c85:outspr$="file_690":
open_save
&outspr$="file_c85":dodgy%=
cjpeg
open_save
 type%<>&C85 
 ot$="Jpeg"
 i%=0 
 i%=0 s%=0 
 s%=1
 s%=1 
B type_menu%!(28+(24*i%)+8)=type_menu%!(28+(24*i%)+8) 
 (1<<22)
C type_menu%!(28+(24*i%)+8)=type_menu%!(28+(24*i%)+8) 
(1<<22)
 ot$="Clear":type_tick%=1
 i%=0 
 i%<>0 s%=0 
 s%=1
type_tick(i%,0)
 s%=1 
B type_menu%!(28+(24*i%)+8)=type_menu%!(28+(24*i%)+8) 
 (1<<22)
C type_menu%!(28+(24*i%)+8)=type_menu%!(28+(24*i%)+8) 
(1<<22)
type_tick(1,1)
 "WimpExt_SetIconString",0,,save%,4,ot$
 "WimpExt_SetIconString",0,,save%,2,fn$
*!q%=save%:
 "Wimp_GetWindowState",,q%
 "Wimp_OpenWindow",,q%
 "WimpExt_PutCaretIcon",,,save%,2
save_click
 q%!16 
begin_drag
 5:!q%=save%:
 "Wimp_GetWindowState",,q%:ox%=q%!4-q%!20:oy%=q%!16-q%!24
 "WimpExt_CreateMenu",,type_menu%,ox%+266,oy%-200:menu%=type_menu%
save_to_disc
string(q%+44,-1)
do_save(fn$)
begin_drag
 os%>=310 
 sol%=
 sol%=
 "XOS_SWINumberFromString",,"DragASprite_Start" 
 (e% 
 1)=1 
 sol%=
 sol% 
solid_drag 
outline_drag
drag%=
solid_drag
 f%=%01000101:
bbox(q%,q%+16)
s$=outspr$
 "DragASprite_Start",f%,1,s$,q%,q%+16
outline_drag
&!q%=save%:q%!4=5:
bbox(q%+8,q%+24)
 "Wimp_DragBox",,q%
bbox(cbox%,bbox%)
4!buffer%=save%:
 "Wimp_GetWindowState",,buffer%
6ox%=buffer%!4-buffer%!20:oy%=buffer%!16-buffer%!24
/buffer%!4=3:
 "Wimp_GetIconState",,buffer%
0cbox%!0=ox%+buffer%!8:cbox%!4=oy%+buffer%!12
2cbox%!8=ox%+buffer%!16:cbox%!12=oy%+buffer%!20
:bbox%!0=0:bbox%!4=0:bbox%!8=&7FFFFFFF:bbox%!12=bbox%!8
 "WimpExt_GetIcon",,,save%,2 
 ,,,t%:out$=
string(t%,-1)
do_save(out$)
drag_end
drag%=
 sol% 
 "XDragASprite_Stop" 
 "XWimp_DragBox",,-1
check_save
check_save
 "WimpExt_GetIcon",,,save%,2 
 ,,,t%:t$=
string(t%,-1)
 "WimpExt_FindLeaf",t$ 
 leaf$
 "OS_File",17,"<Wimp$ScrapDir>.S2Jpeg.Jpeg" 
 ,,,,size%
 "Wimp_GetPointerInfo",,q%:win%=q%!12:ic%=q%!16
=q%!16=1:q%!20=win%:q%!24=ic%:q%!28=!q%:q%!32=q%!4:!q%=100
,q%!36=size%:q%!40=&c85:$(q%+44)=leaf$+
 "Wimp_SendMessage",17,q%,win% 
 reciever%
do_save(out$)
 "XOS_File",17,out$ 
 e%:go%=
error("Message from Sprite 2 Jpeg",%10,"A directory exists with this name",0):go%=
error("Message from Sprite 2 Jpeg",%111,"This file already exists - continue ?",0)
!       
 err_click%=0 
 go%=
 No file exists here
 go% 
 outspr$<>"file_c85" 
djpeg
 "OS_SetVarVal","Temp$Temp",out$
 "Wimp_StartTask","Copy <S2J$Scrap>.Jpeg <Temp$Temp> D~V~CFSL~N~PQ~R~T"
 "OS_CLI","Unset Temp$Temp"
'!q%=save%:
 "Wimp_CloseWindow",,q%
cjpeg
<switches$="-Q "+
quality%:
 optimise% 
 switches$+=" -o"
 cdebug% 
 switches$+=" -d"
 interleave% 
 switches$+=" -I"
 arithmetic% 
 switches$+=" -a"
 cxtra$<>"" 
 switches$+=cxtra$
 "OS_SetVarVal","Temp$Temp",fn$
Lcomm$="<ChangeFSI$Dir>.ChangeFSI <Temp$Temp> <S2J$Scrap>.PBM P6 -nomode"
 "Wimp_StartTask",comm$
	Xredir$=" { > <Wimp$ScrapDir>.S2Jpeg.Output }":
 dodgy%) 
 (cdebug%=
 redir$=""
Kcomm$="S2J:cjpeg "+switches$+" <S2J$Scrap>.PBM <S2J$Scrap>.Jpeg"+redir$
 dodgy%=
 "XOS_CLI","Remove <Wimp$ScrapDir>.S2Jpeg.Output"
 "Wimp_StartTask",comm$
 "XOS_File",17,"<S2J$Scrap>.Jpeg" 
 e%<>1 
error("Message from Sprite 2 Jpeg",1,"Sorry, something went wrong",0):
 "XOS_CLI","Remove <S2J$Scrap>.PBM"
 "XOS_CLI","X SetType <S2J$Scrap>.Jpeg c85"
 "OS_CLI","Unset Temp$Temp"
open_save
djpeg
 type_tick% 
 1:cfo$=""
 2:cfo$="28"
 3:cfo$="s32"
 4:cfo$=""
 5:cfo$=""
:switches$=""
 quantize% 
 switches$="-q "+
quant_to%
 passes% 
 switches$+=" -1"
 dither% 
 switches$+=" -D"
 grey% 
 switches$+=" -g"
 xblock% 
 switches$+=" -b"
 ddebug% 
 switches$+=" -d"
 dxtra$<>"" 
 switches$+=dxtra$
 type_tick% 
 1,2,3:switches$+=" -P"
 4:switches$+=" -G"
 5:switches$+=" -T"
 "OS_SetVarVal","Temp$Temp",in$
*Kredir$=" { > <Wimp$ScrapDir>.S2Jpeg.Output }":
 (ddebug%=
 redir$=""
+Hcomm$="S2J:djpeg "+switches$+" <Temp$Temp> <S2J$Scrap>.Jpeg2"+redir$
 "Wimp_StartTask",comm$
 "WimpExt_PrePoll"
 "Wimp_Poll",,q% 
 reason%
 "WimpExt_Action",s2jpeg%,q%,reason% 
 reason%
 reason% 
 17,18,19:
 q%!16=0 
 quit%=
 "XOS_File",17,"<S2J$Scrap>.Jpeg2" 
 e%=1
 grey% 
 s$=" -d" 
 s$=""
 type_tick% 
pbm_clear("<S2J$Scrap>.Jpeg2","<S2J$Scrap>.Jpeg",0)
:4       
SYS "XOS_CLI","Remove <S2J$Scrap>.Jpeg2"
 2:comm$="<ChangeFSI$Dir>.ChangeFSI <S2J$Scrap>.Jpeg2 <S2J$Scrap>.Jpeg 28 -nomode"+s$
<L       
 "Wimp_StartTask",comm$:
 "XOS_CLI","Remove <S2J$Scrap>.Jpeg2"
 3:comm$="<ChangeFSI$Dir>.ChangeFSI <S2J$Scrap>.Jpeg2 <S2J$Scrap>.Jpeg S32,90,90 -nomode"
>L       
 "Wimp_StartTask",comm$:
 "XOS_CLI","Remove <S2J$Scrap>.Jpeg2"
 "XOS_CLI","SetType <S2J$Scrap>.Jpeg2 695"
@C       
 "XOS_CLI","Rename <S2J$Scrap>.Jpeg2 <S2J$Scrap>.Jpeg"
 "XOS_CLI","SetType <S2J$Scrap>.Jpeg2 69D"
BC       
 "XOS_CLI","Rename <S2J$Scrap>.Jpeg2 <S2J$Scrap>.Jpeg"
string(a%,l%)
d$="":
 l%>0 
 i%=0 
 l%-1
 d$+=
(a%?i%)
L# i%=0:max%=255:
 l%<-1 max%=-l%
d$,1)<>
d$,1)<>
 i%<=max%
 d$+=
(a%?i%):i%+=1
d$,1)=
d$-1)
error(title$,buttons%,mess$,fatal%)
LOCAL ERROR:ONERROR ERROR 0,REPORT$+" in error handler at line "+STR$ERL:END
 buttons% 
 0:$buffer%="OK"+
0:die%=-1
 1:$buffer%="OK"+
0:die%=-1
 2:$buffer%="Cancel"+
0:die%=0
 3:$buffer%="OK"+
0+"Cancel"+
0:die%=1
 7:$buffer%="Cancel"+
0+"OK"+
0:die%=0
 "WimpExt_OpenRequester",,,title$,mess$,buffer%,die%
 "WimpExt_PrePoll"
 "Wimp_Poll",,buffer% 
 reason%
 "WimpExt_Action",s2jpeg%,buffer%,reason% 
 reason%
 reason% 
 "WimpExt_AutoRedraw",,buffer%
 "WimpExt_OpenLinked",,buffer%
 "WimpExt_CloseLinked",,buffer%
 buffer%!16=die% 
 fatal%=1 
 quit%=
 17,18,19:
recieve
 ((reason%=6 
 buffer%!12=-3) 
 quit%=
err_click%=buffer%!16
 "Wimp_Initialise",200,&4B534154,"Sprite 2 Jpeg" 
 os%,s2jpeg%
 "WimpExt_Initialise",14,s2jpeg%,1874:q_size%=32*1024
p)quit%=
:sl%=
 q% q_size%,buffer% 64
 "WimpExt_IconBarSprite",,,-1,"!spr2jpeg",,3 
 iconbar%
 "WimpExt_Heap",0,
 "WimpExt_Heap",2,0,1800 
 ,temp_block%
 temp_block%=0 
 Error 0,"Insufficient memory - please free some memory and try again"
load_sprites
load_templates
make_menu
load_options
create_dir
create_dir
 "XOS_File",17,"<Wimp$ScrapDir>.S2Jpeg" 
 e%=0 
 "OS_CLI","CDir <Wimp$ScrapDir>.S2Jpeg"
read_vars
 "WimpExt_GetNumberIcon",10,,innards%,4 
 quality%
icon_state(5,optimise%,0)
icon_state(6,cdebug%,0)
icon_strng(7,cxtra$,0)
icon_state(9,interleave%,0)
icon_state(10,arithmetic%,0)
icon_state(11,quantize%,0)
 "WimpExt_GetNumberIcon",10,,innards%,12 
 quant_to%
icon_state(13,passes%,0)
icon_state(14,dither%,0)
icon_state(15,grey%,0)
icon_state(16,xblock%,0)
icon_state(17,ddebug%,0)
icon_strng(18,dxtra$,0)
 quant_to%<8 quant_to%=8
 quant_to%>256 quant_to%=256
 quality%>100 quality%=100
 "WimpExt_SetIconString",0,,innards%,12,
quant_to%
 "WimpExt_SetIconString",0,,innards%,4,
quality%
set_vars
 quant_to%<8 quant_to%=8
 quant_to%>256 quant_to%=256
 quality%>100 quality%=100
 "WimpExt_SetIconString",0,,innards%,4,
quality%
icon_state(5,optimise%,1)
icon_state(6,cdebug%,1)
icon_strng(7,cxtra$,1)
icon_state(9,interleave%,1)
icon_state(10,arithmetic%,1)
icon_state(11,quantize%,1)
icon_state(13,passes%,1)
icon_state(14,dither%,1)
icon_state(15,grey%,1)
icon_state(16,xblock%,1)
icon_state(17,ddebug%,1)
icon_strng(18,dxtra$,1)
shade(12,-(quantize%=0))
shade(13,-(quantize%=0))
shade(i%,s%)
3!q%=innards%:q%!4=i%:
 "Wimp_GetIconState",,q%
 0:c%=1<<22:e%=0
 1:c%=1<<22:e%=c%
 2:c%=0:e%=1<<22
c%=0:e%=0
:q%!8=e%:q%!12=c%
 "Wimp_SetIconState",,q%
icon_strng(i%,
 x$,w%)
 "WimpExt_GetIcon",,,innards%,i% 
 ,,,t%
 $t%=x$+
string(t%,-1)
save_options
("<S2J$Dir>.Resources.Choices")
#f%,quality%
#f%,optimise%
#f%,cdebug%
#f%,interleave%
#f%,arithmetic%
#f%,quantize%
#f%,quant_to%
#f%,passes%
#f%,dither%
#f%,grey%
#f%,xblock%
#f%,ddebug%
#f%,dxtra$
load_options
("<S2J$Dir>.Resources.Choices")
quality%=
optimise%=
cdebug%=
interleave%=
arithmetic%=
quantize%=
quant_to%=
passes%=
dither%=
grey%=
xblock%=
ddebug%=
dxtra$=
set_vars
icon_state(i%,
 v%,wr%)
 wr%=1 v%=v% 
B!buffer%=innards%:buffer%!4=i%:
 "Wimp_GetIconState",,buffer%
$f%=buffer%!24:old%=((f%>>21)
 wr%=0 
 v%=old% 
v%=v% 
 1:f%=0
 v%=1 
 c%=1<<21:e%=1<<21
 c%=1<<21:e%=0
buffer%!8=e%:buffer%!12=c%
 "Wimp_SetIconState",,buffer%
v%=old% 
load_sprites
("<S2J$Dir>.Resources.Sprites")
size%=
 #f%+4:
 sprites% size%
!!sprites%=size%:sprites%!8=16
 "OS_SpriteOp",&10A,sprites%,"<S2J$Dir>.Resources.Sprites"
load_templates
$buffer%=
 ind% 1370
 "WimpExt_LoadTemplates",buffer%,!temp_block%,ind%,ind%+1370,-1,"<S2J$Dir>.Resources.Templates",sprites%
Iinfo%=!buffer%:options%=buffer%!4:save%=buffer%!8:innards%=buffer%!12
 "WimpExt_LinkWindows",,,options%,innards%
 "WimpExt_Heap",13
make_menu
 main_menu% 100,type_menu% 28+24*8,d% 14
 os%<310 
! $main_menu%="Sprite2Jpeg"+
! $main_menu%="Sprite2Jpeg"+
Lmain_menu%!12=&70207:main_menu%!16=9*16:main_menu%!20=44:main_menu%!24=0
Vmain_menu%!28=0:main_menu%!32=info%:main_menu%!36=&7000021:$(main_menu%+40)="Info"
Umain_menu%!52=&80:main_menu%!56=-1:main_menu%!60=&7000021:$(main_menu%+64)="Quit"
Hm%=type_menu%:$m%="Save as":m%!12=&70207:m%!16=9*16:m%!20=44:m%!24=0
:m%!28=3:m%!32=-1:m%!36=&7000021:$(m%+40)="Jpeg":m%+=24
;m%!28=0:m%!32=-1:m%!36=&7000021:$(m%+40)="Clear":m%+=24
Bm%!28=0:m%!32=-1:m%!36=&7000021:$(m%+40)="8-bit sprite":m%+=24
-m%!28=&0:m%!32=-1:m%!36=&7000121:m%!40=d%
3$d%="24-bit sprite"+
0:m%!44=-1:m%!48=14:m%+=24
9m%!28=0:m%!32=-1:m%!36=&7000021:$(m%+40)="GIF":m%+=24
=m%!28=&80:m%!32=-1:m%!36=&7000021:$(m%+40)="Targa":m%+=24
pbm_clear(pbm$,clr$,dir%)
 0,"Error: "+
$+" at line "+
 dir=0, pbm->clr, dir=1, clr->pbm
 "XOS_File",17,pbm$ 
 "XOS_File",17,clr$ 
 p%=0 
 c%=0 
error("Message from Sprite 2 Jpeg",%10,"Neither a PBM or Clear image exists",0):
 p%=2 
 c%=2 
error("Message from Sprite 2 Jpeg",%10,"One file is a directory",0):
 dir%=0 
 "OS_ReadMemMapInfo" 
 "Wimp_SlotSize",-1,-1 
 c%,n%,f%:f%-=ps%*40
  block%=q%:bs%=q_size%
 "WimpExt_Heap",0,
 "WimpExt_Heap",2,0,f% 
 ,temp_block%
 temp_block%<>0 
(!   block%=!temp_block%:bs%=f%
   block%=q%:bs%=q_size%
 convert PBM to Clear
 pbm%=
 pbm$
#pbm%
 p$<>"P6" 
 "converting to P6"
 #pbm%
 "OS_SetVarVal","Temp$Temp",pbm$
4O  comm$="<ChangeFSI$Dir>.ChangeFSI <Temp$Temp> <S2J$Scrap>.PBM6 P6 -nomode"
 "Wimp_StartTask",comm$:
 convert PX to P6
 "XOS_CLI","Remove Temp$Temp"
 "XOS_CLI","Copy <SJ2$Scrap>.PBM6 <Temp$Temp> D~V~CFSL~N~PQ~R~T"
  pbm%=
 pbm$
  a%=
#pbm%:a%=
#pbm%+48
 pbm is now 24-bpp, binary encoded
#pbm%:
m$,1)<>"#" 
#pbm%
 s$=m$:m$="Sprite 2 Jpeg"
 width%=
s$," ")-1))
?! height%=
s$," ")))
 max%=
#pbm%)
 clr%=
(clr$):m$+=
m=LENm$:m$+=STRING$(4-(m MOD 4),CHR$0)
IF (m MOD 4)=0 THEN m$+=STRING$(CHR$0,4)
so(clr%,m$)
wo(clr%,105)
wo(clr%,width%)
wo(clr%,height%)
wo(clr%,24)
 i%=1 
 ((height%*width%*3) 
 bs%)
 "OS_GBPB",4,pbm%,block%,bs% 
 ,,,not_done%
 "OS_GBPB",2,clr%,block%,bs%
M& spare%=((height%*width%*3) 
 bs%)
 "OS_GBPB",4,pbm%,block%,spare% 
 ,,,not_done%
 "OS_GBPB",2,clr%,block%,spare%
# clr%
# pbm%
 "XOS_CLI","SetType "+clr$+" 690"
 "XWimpExt_Heap",13
error("Message from Sprite 2 Jpeg",%10,"Cannot convert from Clear to PBM",0):
wo(fh%,wo%)
b%=wo% 
 255:
 #fh%,b%
b%=(wo%>>8) 
 255:
 #fh%,b%
\ b%=(wo%>>16) 
 255:
 #fh%,b%
] b%=(wo%>>24) 
 255:
 #fh%,b%
so(fh%,s$)
i%=1 
#fh%,
s$,i%,1))