home *** CD-ROM | disk | FTP | other *** search
/ The Datafile PD-CD 2 / DATAFILE_PDCD2.iso / utilities / _ampcalc / !AmpCalc / !RunImage (.txt) < prev    next >
Encoding:
RISC OS BBC BASIC V Source  |  1994-02-13  |  12.3 KB  |  618 lines
  1.  >AmpCalc
  2.  version 1.77 - Sun 13th February 94
  3.  Copyright 
  4.  A. M. Pereira of 'Armful
  5. %vers$="1.77 (13th February 1994)"
  6.  q% 1024, iicon 2048, menu 76:iend=iicon+2048:ip=iicon
  7.  mem$(9):undo$=""
  8.  a%=1 
  9.  mem$(a%)
  10.  "AmpCalc - The amazing calculator!","Written by Ampy","An ArmFul production"
  11.  "Contact: 2:251/16.50 @fidonet","Have you registered?"
  12.  "What junk shall I put in these memories?","Cash donations ARE accepted :-)"
  13.  "This program is Freeware","Have fun!"
  14. ("<AmpCalc$Dir>.Config")
  15. /temp$="Templates":dragwindows%=
  16. :convswi%=
  17.      a$=
  18. a$,1,1)<>"|" 
  19.  b%=1 
  20. -    
  21. a$,b%,1))>64 
  22. a$,b%,1))<91 
  23. '       
  24. a$,b%,1)=
  25. a$,b%,1))+32)
  26.         
  27.   param$=
  28. a$,":")+1)
  29. a$,1,5) 
  30. 4    
  31.  "conve": 
  32.  param$="text" temp$="TemplText"
  33. 4    
  34.  "dragw": 
  35. param$,1,1)="n" dragwindows%=
  36. 0    
  37.  "swico": 
  38. param$,1,1)="n" convswi%=
  39.  "Wimp_Initialise",200,&4b534154,"AmpCalc" 
  40.  wimpv,task_h
  41.  "Wimp_OpenTemplate",,"<AmpCalc$Dir>."+temp$
  42.  "Wimp_LoadTemplate",,q%,ip,iend,-1,"calc",0 
  43.  "Wimp_CreateWindow",,q% 
  44.  calc_h%
  45.  "Wimp_LoadTemplate",,q%,ip,iend,-1,"ProgInfo",0 
  46.  "Wimp_CreateWindow",,q% 
  47.  info_h%
  48.  "Wimp_LoadTemplate",,q%,ip,iend,-1,"basswi",0 
  49.  "Wimp_CreateWindow",,q% 
  50.  basswi_h%
  51.  "Wimp_CloseTemplate"
  52.  wimpv=2 
  53. seticon(info_h%, 5, vers$) 
  54. seticon(info_h%, 6, vers$)
  55. ,M!q%=-1:q%!4=0:q%!8=0:q%!12=68:q%!16=68:q%!20=&3002:$(q%+24)="!ampcalc"+
  56.  "Wimp_CreateIcon",,q% 
  57.  icbar
  58. .F$menu="AmpCalc"+
  59. 0:menu!12=&70207:menu!16=160:menu!20=44:menu!24=0
  60. /Emenu!28=&00:menu!32=info_h%:menu!36=&7000031:$(menu+40)="Info"+
  61. 0@menu!52=&80:menu!56=-1:menu!60=&7000031:$(menu+64)="Quit"+
  62. base%=10:pollnull%=1
  63. quit%=
  64. error
  65.  "Wimp_Poll",%110000110000 
  66.  pollnull%,q% 
  67.  event
  68.  event 
  69. 7$    
  70.  "Wimp_OpenWindow",,q%
  71. 8%    
  72.  "Wimp_CloseWindow",,q%
  73. 9,    
  74.  q%!12=-2 
  75. barclick 
  76. winclick
  77. keypress
  78.  !q%=1 quit%=
  79.  17,18:
  80. message
  81.  quit%
  82.  "Wimp_CloseDown",task_h,&4b534154
  83. message
  84.  q%!16 
  85.  0:quit%=
  86. filedrop
  87. filedrop
  88.  q%!40 
  89.  &fff:
  90. L       a%=!q%:b%=q%!4:c%=q%!8
  91.       
  92. droptext(
  93. getfd)
  94.       !q%=a%:q%!4=b%
  95.       q%!12=c%
  96.       q%!16=4
  97.       q%!20=-2
  98.       q%!24=icbar
  99. S*      
  100.  "Wimp_SendMessage",17,q%,q%!4
  101.  &ffb:
  102.       
  103. basswi_open(
  104. getfd)
  105. getfd
  106. fd$=""
  107. fdchar$=""
  108.  X<256 
  109.  fdchar$<>
  110.   fd$+=fdchar$
  111.   fdchar$=
  112. (q%?X)
  113.   X+=1
  114. barclick
  115.  (q%!8 
  116.  %100)=%100 
  117.   !q%=calc_h%
  118.  "Wimp_GetWindowState",,q%
  119.   q%!28=-1
  120.  "Wimp_OpenWindow",,q%
  121.  (q%!8 
  122.  %010)=%010 
  123.  "Wimp_CreateMenu",,menu,!q%-64,184
  124. keypress
  125.  done%
  126. done%=
  127.  q%!24=17 !q%=calc_h%:
  128.  "Wimp_CloseWindow",,q%:done%=
  129.  q%!24=13 
  130. eval:done%=
  131.  q%!24=19 
  132. swi:done%=
  133.  q%!24=2 
  134. tobin:done%=
  135.  q%!24=4 
  136. todec:done%=
  137.  q%!24=24 
  138. tohex:done%=
  139.  q%!24=25 
  140. tok:done%=
  141.  q%!24=11 
  142. tob:done%=
  143.  q%!24=61 
  144. equals:done%=
  145.  q%!24>&180 
  146.  q%!24<&18A 
  147. recallmem:done%=
  148.  q%!24>&190 
  149.  q%!24<&19A 
  150. setmem:done%=
  151.  q%!24=&1CA 
  152.  undo$<>"" 
  153.   u$=
  154. geticon(calc_h%, 0)
  155. seticon(calc_h%, 0, undo$)
  156.   undo$=u$
  157.   done%=
  158. done% 
  159.  "Wimp_ProcessKey",q%!24
  160. winclick
  161.  (q%!8=64 
  162.  q%!8=16) 
  163.  q%!12=info_h% 
  164. dragwin
  165.  q%!12=basswi_h% 
  166.  q%!16 
  167. doconv
  168. dontconv
  169. %    
  170.  (q%!8 
  171.  %010)=0 
  172. dragwin
  173.  q%!12=calc_h% 
  174.  q%!16 
  175. toasc
  176. fromasc
  177. tobin
  178. todec
  179. tohex
  180. toswi
  181. fromswi
  182. spr16
  183. '    
  184. eval :
  185.  multiply by 1 :-)
  186. %    
  187.  (q%!8 
  188.  %010)=0 
  189. dragwin
  190. dragwin
  191.  dragwindows% 
  192.   q%!4=q%!12
  193.  "Wimp_GetWindowOutline",,q%+4
  194.   !q%=q%!4
  195.   q%!4=1
  196.  "Wimp_DragBox",,q%
  197. toasc
  198. seticon(calc_h%, 0, 
  199. cbase(
  200. geticon(calc_h%, 0))))
  201. fromasc
  202. geticon(calc_h%, 0))>31 
  203. seticon(calc_h%, 0, 
  204. geticon(calc_h%, 0))))
  205. geticon(calc_h%, 0), 1, 1)<"A" 
  206. fromswi 
  207. toswi
  208. fromswi
  209.  swin=
  210. geticon(calc_h%, 0))
  211.  "OS_SWINumberToString",swin,q%,600 
  212. q%?l=13
  213. seticon(calc_h%, 0, 
  214. $q%))
  215. toswi
  216. seticon(calc_h%, 0, ""):
  217. geticon(calc_h%, 0),1,10)="OS_WriteI+" 
  218. os_writei
  219.  "OS_SWINumberFromString",,
  220. geticon(calc_h%, 0) 
  221. seticon(calc_h%, 0, 
  222. cbase(swi))
  223. os_writei
  224. !end$=
  225. geticon(calc_h%,0),11)
  226.  end$<>"0" 
  227. (end$)=0 end$=
  228. ("ASC"+end$))
  229. seticon(calc_h%, 0, 
  230. cbase(
  231. (end$)+256))
  232. tobin
  233. seticon(calc_h%, 0, "%0"):
  234. unsetbase
  235. base%=2
  236. 3!q%=calc_h%:q%!4=4:q%!8=&b000000:q%!12=&f000000
  237.  "Wimp_SetIconState",,q%
  238. geticon(calc_h%, 0)<>"" 
  239. seticon(calc_h%, 0, 
  240. cbase(
  241. geticon(calc_h%, 0))))
  242. todec
  243. seticon(calc_h%, 0, "0"):
  244. unsetbase
  245. base%=10
  246. 3!q%=calc_h%:q%!4=5:q%!8=&b000000:q%!12=&f000000
  247.  "Wimp_SetIconState",,q%
  248. geticon(calc_h%, 0)<>"" 
  249. seticon(calc_h%, 0, 
  250. cbase(
  251. geticon(calc_h%, 0))))
  252. tohex
  253. seticon(calc_h%, 0, "&0"):
  254. unsetbase
  255. base%=16
  256. 3!q%=calc_h%:q%!4=6:q%!8=&b000000:q%!12=&f000000
  257.  "Wimp_SetIconState",,q%
  258. geticon(calc_h%, 0)<>"" 
  259. seticon(calc_h%, 0, 
  260. cbase(
  261. geticon(calc_h%, 0))))
  262. unsetbase
  263. 3!q%=calc_h%:q%!4=4:q%!8=&7000000:q%!12=&f000000
  264.  "Wimp_SetIconState",,q%
  265. 3!q%=calc_h%:q%!4=5:q%!8=&7000000:q%!12=&f000000
  266.  "Wimp_SetIconState",,q%
  267. 3!q%=calc_h%:q%!4=6:q%!8=&7000000:q%!12=&f000000
  268.  "Wimp_SetIconState",,q%
  269. seticon(w, i, s$)
  270.  "Wimp_GetCaretPosition",,q%+200
  271.  q%!200=w 
  272.  q%!204=i 
  273. (s$)<24 
  274. (s$) 
  275.  ci=23
  276.  "Wimp_SetCaretPosition",q%!200,q%!204,-1,-1,-1,ci
  277.     4q%!600=w:q%!604=i:
  278.  "Wimp_GetIconState",,q%+600
  279. $(q%!628)=s$
  280. 4q%!608=0:q%!612=0:
  281.  "Wimp_SetIconState",,q%+600
  282. geticon(w, i):
  283.  x,x$
  284. :!(q%+128)=w:!(q%+132)=i:
  285.  "Wimp_GetIconState",,q%+128
  286. .x$="":x=q%!156:
  287.  ?x>31:x$+=
  288. ?x:x+=1:
  289. undo$=
  290. geticon(calc_h%, 0)
  291. check 
  292.  0 : 
  293. toswi
  294.  1 : 
  295. seticon(calc_h%, 0, 
  296. cbase(
  297. geticon(calc_h%, 0))))
  298. cbase(val)
  299.  l,r$
  300.  base% 
  301.  "OS_ConvertBinary4",
  302. (val+0.5),q%+300,200 
  303.  ,l:r$="%"
  304.  10:$(q%+300)=
  305. val:l=q%+300+
  306. val:r$=""
  307.  "OS_ConvertHex8",
  308. (val+0.5),q%+300,200 
  309.  ,l:r$="&"
  310. p%=q%+300:
  311.  ?p%=48:p%+=1:
  312. ?l=13:r$+=$p%:=r$
  313.  0, suspect SWI
  314.  1, suspect calculation
  315.  2, ignore
  316. check
  317. geticon(calc_h%, 0)="" =2
  318. geticon(calc_h%,0))
  319. geticon(calc_h%, 0))>0 
  320. seticon(calc_h%, 0, 
  321. cbase(
  322. geticon(calc_h%, 0))/1024))
  323. geticon(calc_h%, 0))>0 
  324. seticon(calc_h%, 0, 
  325. cbase(
  326. geticon(calc_h%, 0))*1024))
  327. geticon(calc_h%, 0))>0 
  328. geticon(calc_h%, 0))>0 
  329. ??    
  330. seticon(calc_h%, 0, 
  331. cbase(
  332. geticon(calc_h%, 0))/8))
  333. geticon(calc_h%, 0))>0 
  334. geticon(calc_h%, 0))>0 
  335. H?    
  336. seticon(calc_h%, 0, 
  337. cbase(
  338. geticon(calc_h%, 0))/4))
  339. spr16
  340. geticon(calc_h%, 0))>0 
  341. geticon(calc_h%, 0))>0 
  342. Q?    
  343. seticon(calc_h%, 0, 
  344. cbase(
  345. geticon(calc_h%, 0))/2))
  346. equals
  347. geticon(calc_h%, 0)="" 
  348. seticon(calc_h%, 0, "=")
  349.  "Wimp_GetCaretPosition",,q%
  350.  "Wimp_SetCaretPosition",q%!200,q%!204,-1,-1,-1,1
  351. error
  352. a7!q%=
  353. :$(q%+4)=
  354. $+" (internal error code "+
  355. +")"+
  356.  "Wimp_ReportError",q%,3,"AmpCalc" 
  357.  ,fatal
  358.  fatal=2 quit%=
  359. :pollnull%=0
  360. droptext(fn$)
  361.  total%, file%, line$
  362. file%=
  363. (fn$)
  364. total%=0
  365. #file%
  366.  q$="FEBBS" 
  367.     line$=
  368. #file%
  369. line$,1,1)<>" " 
  370. o#      line$=
  371. line$,
  372. line$," "))
  373.       
  374. q-        
  375. line$,1,1)=" " line$=
  376. line$,2)
  377.       
  378. line$,1,1)<>" "
  379.       total%+=
  380. (line$)
  381. t        
  382. #file%
  383. #file%=0
  384.     line$=
  385. #file%
  386. z-    
  387. line$,1,1)="#" 
  388. line$,1,1)="0" 
  389.       line$=
  390. line$,24)
  391.       
  392. }-        
  393. line$,1,1)=" " line$=
  394. line$,2)
  395.       
  396. line$,1,1)<>" "
  397.       total%+=
  398. (line$)
  399.         
  400. #file%
  401.  #file%
  402. seticon(calc_h%, 0, 
  403. cbase(total%))
  404. basswi_open(fn$)
  405. seticon(basswi_h%, 6, fn$)
  406. !q%=basswi_h%
  407.  "Wimp_GetWindowState",,q%
  408. q%!28=-1
  409.  "Wimp_OpenWindow",,q%
  410. dontconv
  411. !q%=basswi_h%
  412.  "Wimp_CloseWindow",,q%
  413. issel(w, i)
  414. q%!128=w:q%!132=i
  415.  "Wimp_GetIconState",,q%+128
  416. =(q%!152 
  417.  1<<21)
  418. doconv
  419. issel(basswi_h%, 4) 
  420. basswi_tonum(
  421. geticon(basswi_h%, 6))
  422. issel(basswi_h%, 5) 
  423. basswi_toname(
  424. geticon(basswi_h%, 6))
  425. basswi_tonum(f$)
  426. hex%=
  427. issel(basswi_h%, 7)
  428. space%=
  429. issel(basswi_h%, 8)
  430.  "Hourglass_On"
  431. q2%=q%+&100
  432.  "OS_File",5,f$ 
  433.  ,,,,len%
  434.  "OS_Module",6,,,len%+4096 
  435.  ,,outstart%
  436.  "OS_Module",7,,outstart%:
  437.  #in%:
  438.  "Hourglass_Off":
  439. dontconv:
  440. error:
  441. outp%=outstart%
  442. ?outp%=
  443.  #in%:outp%+=1
  444.   ?q%=
  445.  #in%
  446.  ?q%=&ff 
  447.     ?outp%=&ff
  448.     outp%+=1
  449.     q%?1=
  450.  #in%
  451.     q%?2=
  452.  #in%
  453. &    
  454.  "OS_GBPB",4,in%,q%+3,q%?2-3
  455.     !q2%=!q%
  456.     a=q%+3:b=q2%+3
  457.  ?a<>13
  458. 1      
  459.  (?a=&C8 
  460.  a?1=&99) 
  461. swicommand(a) 
  462. ,        !b=!a:
  463. swicommand(a) a+=1:b+=1
  464.         a+=2:b+=2
  465.         sys$=""
  466.         
  467.  ?a=32
  468.           a+=1
  469.         
  470.         
  471.  ?a=34 
  472.           a+=1
  473.           
  474.  ?a<>34
  475.             sys$+=
  476.             a+=1
  477.           
  478.           a+=1
  479. =          
  480.  "XOS_SWINumberFromString",,sys$ 
  481.  num ;flags
  482.           
  483.  (flags 
  484.  1)=1 
  485.             $b=
  486. 34+sys$+
  487.           
  488. -            
  489.  hex% $b="&"+
  490. ~num 
  491.           
  492.            
  493.  space% $b=" "+$b
  494.           b+=
  495.         
  496.       
  497.         ?b=?a
  498.         a+=1:b+=1
  499.       
  500.         
  501.     ?b=?a
  502.     q2%?2=b+1-q2%
  503.  a=0 
  504.  q2%?2-1
  505.       ?outp%=q2%?a
  506.       outp%+=1
  507.         
  508.  #in%
  509.  #in%
  510.  "OS_File",10,f$,&ffb,,outstart%,outp%
  511.  "OS_Module",7,,outstart%
  512.  "Hourglass_Off"
  513. dontconv
  514. basswi_toname(f$)
  515.     num=0
  516. space%=
  517. issel(basswi_h%, 8)
  518.  "Hourglass_On"
  519. q2%=q%+&100
  520.  "OS_File",5,f$ 
  521.  ,,,,len%
  522.  "OS_Module",6,,,len%*2 
  523.  ,,outstart%
  524.  "OS_Module",7,,outstart%:
  525.  #in%:
  526.  "Hourglass_Off":
  527. dontconv:
  528. error:
  529. outp%=outstart%
  530. ?outp%=
  531.  #in%:outp%+=1
  532.   ?q%=
  533.  #in%
  534.  ?q%=&ff 
  535.     ?outp%=&ff
  536.     outp%+=1
  537.     q%?1=
  538.  #in%
  539.     q%?2=
  540.  #in%
  541. &    
  542.  "OS_GBPB",4,in%,q%+3,q%?2-3
  543.     !q2%=!q%
  544.     a=q%+3:b=q2%+3
  545.  ?a<>13
  546. 1      
  547.  (?a=&C8 
  548.  a?1=&99) 
  549. swicommand(a) 
  550. ,        !b=!a:
  551. swicommand(a) a+=1:b+=1
  552.         a+=2:b+=2
  553.         sys$=""
  554.         
  555.  ?a=32
  556.           a+=1
  557.         
  558.         
  559.  ?a<>34 
  560. 2          
  561.  ?a<>13 
  562.  ?a<>32 
  563.  ?a<>44 
  564.  ?a<>58
  565.             sys$+=
  566.             a+=1
  567.           
  568. B          
  569.  "OS_SWINumberToString",
  570. sys$,q%+&200,&100 
  571.  ,,num
  572. !          ?(q%+&200+num-1)=13
  573. #          
  574.  $(q%+&200)="User" 
  575.             $b=sys$
  576.           
  577.     %            $b=
  578. 34+$(q%+&200)+
  579.           
  580.            
  581.  space% $b=" "+$b
  582.           b+=
  583.         
  584.       
  585.         ?b=?a
  586.         a+=1:b+=1
  587.       
  588.         
  589.     ?b=?a
  590.     q2%?2=b+1-q2%
  591. 4    
  592.  (b+1-q2%)>255 
  593.  1,"Expanded line too long"
  594.  a=0 
  595.  q2%?2-1
  596.       ?outp%=q2%?a
  597.       outp%+=1
  598.         
  599.  #in%
  600.  #in%
  601.  "OS_File",10,f$,&ffb,,outstart%,outp%
  602.  "OS_Module",7,,outstart%
  603.  "Hourglass_Off"
  604. dontconv
  605. recallmem
  606. seticon(calc_h%, 0, mem$(q%!24-&181))
  607. setmem
  608. ()mem$(q%!24-&191)=
  609. geticon(calc_h%, 0)
  610. swicommand(addr%)
  611. ,f=(convswi% 
  612.  ((?addr%=83 
  613.  ?addr%=115) 
  614.  (addr%?1=87 
  615.  addr%?1=119) 
  616.  (addr%?2=73 
  617.  addr%?2=105)))
  618.