home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
ARM Club 3
/
TheARMClub_PDCD3.iso
/
hensa
/
converters
/
spr2jpeg_1
/
!Spr2Jpeg
/
!RunImage
(
.txt
)
< prev
next >
Wrap
RISC OS BBC BASIC V Source
|
1995-04-28
|
18KB
|
672 lines
!RunImage for Sprite 2 Jpeg
David Rodgman '95
Freeware !
See Help file for details
$+" at line "+
"XOS_CLI","Unset S2J$Dir":
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%
"XOS_CLI","X Remove <S2J$Scrap>.Jpeg":
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*3:menu%=main_menu%
set_vars:!q%=options%
"Wimp_GetWindowState",,q%:q%!28=-1
"WimpExt_OpenLinked",,q%
"WimpExt_PutCaretIcon",,,innards%,4
options
q%!16=-1
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%
set_vars:!q%=options%
P1
"Wimp_GetWindowState",,q%:q%!28=-1
Q'
"WimpExt_OpenLinked",,q%
R2
"WimpExt_PutCaretIcon",,,innards%,4
2:quit%=
type_menu%
item%=!q%
type_tick(type_tick%,0)
type_tick(item%,1)
type_tick%=item%
type_tick(item%,tick%)
tick%=0
_<type_menu%!(28+24*item%)=type_menu%!(28+24*item%)
a9type_menu%!(28+24*item%)=type_menu%!(28+24*item%)
tick%=1
item%<6
item%
0:t$="file_c85":i$="Jpeg"
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$
m#t$="S"+t$+";wpptr_hand,6,1"+
n/!q%=save%:q%!4=3:
"Wimp_GetIconState",,q%
$(q%!32)=t$:q%!8=0:q%!12=0
"Wimp_SetIconState",,q%
q/!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
"XOS_CLI","X Remove <S2J$Scrap>.Jpeg"
"XOS_CLI","X Remove <S2J$Scrap>.Jpeg2"
"XOS_CLI","X Remove <S2J$Scrap>.Output"
"OS_FSControl",9,"<Wimp$ScrapDir>.S2Jpeg"
,,,,size%
size%<=10240
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)
type_tick(0,1)
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)
< type_menu%!(28+24*5+8)=type_menu%!(28+24*5+8)
(1<<22)
"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
dodgy%
error("Message from Sprite 2 Jpeg",1,"Sorry, something went wrong - Jpeg creation has failed.",0):
error("Message from Sprite 2 Jpeg",1,"Sorry, something went wrong - Jpeg creation has failed. (Bad input file ?)",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)
J4
"XOS_CLI","X Remove <S2J$Scrap>.Jpeg2"
2:comm$="<ChangeFSI$Dir>.ChangeFSI <S2J$Scrap>.Jpeg2 <S2J$Scrap>.Jpeg 28 -nomode"+s$
LL
"Wimp_StartTask",comm$:
"XOS_CLI","Remove <S2J$Scrap>.Jpeg2"
3:comm$="<ChangeFSI$Dir>.ChangeFSI <S2J$Scrap>.Jpeg2 <S2J$Scrap>.Jpeg S32,90,90 -nomode"
NL
"Wimp_StartTask",comm$:
"XOS_CLI","Remove <S2J$Scrap>.Jpeg2"
"XOS_CLI","SetType <S2J$Scrap>.Jpeg2 695"
PC
"XOS_CLI","Rename <S2J$Scrap>.Jpeg2 <S2J$Scrap>.Jpeg"
"XOS_CLI","SetType <S2J$Scrap>.Jpeg2 69D"
RC
"XOS_CLI","Rename <S2J$Scrap>.Jpeg2 <S2J$Scrap>.Jpeg"
string(a%,l%)
d$="":
l%>0
i%=0
l%-1
d$+=
(a%?i%)
\# 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:SYS "XOS_CLI","Unset S2J$Dir":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
6quit%=
:sl%=
:type_tick%=0:
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% 1375
"WimpExt_LoadTemplates",buffer%,!temp_block%,ind%,ind%+1375,-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% 28+24*3,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"
Ymain_menu%!52=0:main_menu%!56=-1:main_menu%!60=&7000021:$(main_menu%+64)="Options..."
Umain_menu%!76=&80:main_menu%!80=-1:main_menu%!84=&7000021:$(main_menu%+88)="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 "+
"XOS_CLI","Unset S2J$Dir":
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
9! block%=!temp_block%:bs%=f%
block%=q%:bs%=q_size%
convert PBM to Clear
pbm%=
pbm$
#pbm%
p$<>"P6"
PRINT "converting to P6"
#pbm%
"OS_SetVarVal","Temp$Temp",pbm$
EO 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))
P! 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%,107)
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%
^& 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%
m b%=(wo%>>16)
255:
#fh%,b%
n b%=(wo%>>24)
255:
#fh%,b%
so(fh%,s$)
i%=1
#fh%,
s$,i%,1))