home *** CD-ROM | disk | FTP | other *** search
/ PDA Software Library / pdasoftwarelib.iso / PSION / SOUNDS / WAVESHOW.OPL < prev    next >
Encoding:
Text File  |  1994-10-05  |  5.7 KB  |  256 lines
  1. proc showwave:(fn$)
  2.  
  3.     local w%,p&
  4.     local h%,mode%,k%,a%
  5.     local ret%,buffer%(512)
  6.     local y%,i,len&,p%,s,offset
  7.     local sp&,sl&
  8.  
  9.     setname    fn$
  10.     
  11.     w%=512
  12.     p&=0
  13.  
  14.     mode%=$0600
  15.     ret%=ioopen(h%,fn$,mode%)
  16.     
  17.     if ret%<0
  18.         showerr:(ret%)
  19.         return
  20.     endif
  21.     
  22.     a%=addr(buffer%(1))
  23.     ret%=ioread(h%,a%,32)
  24.     sp&=int(sp)
  25.     ioseek(h%,3,sp&)
  26.  
  27.     len&=peekl(uadd(a%,18))
  28.     
  29.     if sp+sl>=len&
  30.         if sp=0 : sl=0 : else : sl=len&-sp : endif
  31.     endif
  32.  
  33. rem *** calculate scale ***
  34.     if sl=0
  35.         iadd=flt(len&)/gwidth
  36.     else
  37.         iadd=sl/gwidth
  38.     endif
  39.  
  40.     guse 1
  41.     gcls
  42.     gat 1,12
  43.     gprint "File:",fn$
  44.     gat 1,24
  45.     gprint "Length:",len&,"          "
  46.     
  47.     if sl
  48.         gprint "[Zoom pos:",int(sp),"Zoom len:",int(sl),"]"
  49.     endif
  50.     
  51.     guse swin%
  52.     gcls
  53.     gfont 13
  54.     gat    0,0 : glineby gwidth,0
  55.  
  56.     if iadd
  57.         offset=.1
  58.         if iadd>10 : offset=.2 : endif
  59.         if iadd>50 : offset=.5 : endif
  60.         if iadd>100 : offset=1 : endif
  61.         while s*(8192/iadd)<gwidth
  62.             gat s*(8192/iadd),1
  63.             glineby 0,3
  64.             gat s*(8192/iadd)+3,8
  65.             gprint s+int((sp/8192)*10)/10
  66.             s=s+offset
  67.         endwh
  68.     endif
  69.     
  70.     gat 0,14
  71.     gprint "SECONDS"
  72.  
  73.     guse wwin%    
  74.     gcls
  75.     gat 0,4
  76.     gborder 0,gwidth,gheight-8
  77.  
  78.     p%=0 : i=0 : ret%=0
  79.  
  80.     gupdate off
  81.     gat 0,gheight/2 : glineby gwidth,0
  82.     gat 0,gheight/2
  83.     
  84.     if iadd
  85.  
  86.         do
  87.             if i>=ret%
  88.                 i=i-ret%
  89.                 ret%=ioread(h%,a%,w%)
  90.             endif
  91.             y% = et%(peekb( uadd(a%,i))+1) : i=i+iadd
  92.             glineto p%,(y%)/(8192.0/(gheight-10))+gheight/2
  93.             p%=p%+1
  94.         until p%>=gwidth
  95.  
  96.         gupdate
  97.     
  98.     endif
  99.     ret%=ioclose(h%)
  100.     if ret%
  101.         showerr:(ret%)
  102.     endif
  103.  
  104. endp
  105.  
  106.  
  107. proc showerr:(val%)
  108.  
  109.     at 1,14
  110.     print "Error",val%,err$(val%)
  111.     get
  112. ENDP
  113.  
  114. proc showinfo:
  115.  
  116.     lock on
  117.     if reg%
  118.     dinit "WaveMod 1.1 (Registered)"
  119.     else
  120.     dinit "WaveMod 1.1 (Unregistered)"
  121.     endif
  122.     dtext "","Programmed By Dylan Cuthbert",2
  123.     dtext "","Icon designed by Alistair McNally",2
  124.     dtext "","----------------------",2
  125.     dtext "","(C) Takoyaki Software 1993/4",2
  126.     dtext "","----------------------",2
  127.     dtext "","Please report ideas/bugs to:",2
  128.     dtext "","dyl@cix.compulink.co.uk",2
  129.     dialog
  130.  
  131.     if reg%=0
  132.         dinit "Registration"
  133.         dtext "","For a full registered version send",2
  134.         dtext "","5 (five) UK pounds to:",2
  135.         dtext "","Dylan Cuthbert, 30 Mitton Road, Whalley, Clitheroe, Lancs, BB7 9RX",2
  136.         dtext "","----------------------",2
  137.         dtext "","Feel reassured you are improving the availability,",2
  138.         dtext "","quality, and variety of future Shareware by sending",2
  139.         dtext "","your money today.",2
  140.         dialog
  141.     
  142.         dinit "Registration"
  143.         dtext "","Note:",0
  144.         dtext "","I can only send registered versions via",2
  145.         dtext "","e-mail (due to the cost of s3 media), so",2
  146.         dtext "","please specify the address and type of",2
  147.         dtext "","encoding/compression to use.",2
  148.         dtext "","----------------------",2
  149.         dtext "","Registered users will receive an updated",2
  150.         dtext "","version whenever there is one available.",2
  151.         dialog
  152.  
  153.     dINIT "Other PD/Shareware software"
  154.     dTEXT "","S3A SACI",2
  155.     dTEXT "","Sound Activated Command Interpreter",2
  156.     dTEXT "",REPT$(chr$(196),15),2
  157.     dTEXT "","S3Asm",2
  158.     dTEXT "","S3/S3a based assembler",2
  159.     dTEXT "",REPT$(chr$(196),15),2
  160.     dTEXT "","Email: gsg@cix.compulink.co.uk",2
  161.     dTEXT "","CIS: 71125,532",2
  162.     dialog
  163.  
  164.     else
  165.         dinit "Registered"
  166.         dtext "","----------------------",2
  167.         dtext    "","Thanks for registering.",2
  168.         dtext "","----------------------",2
  169.         dtext "","(C) Takoyaki Software 1993/4",2
  170.         dtext "","Not for resale or re-distribution.",2
  171.         dtext "","All Rights Reserved.",2
  172.         dtext "","----------------------",2
  173.         
  174.         dialog
  175.         
  176.     endif
  177.  
  178.     lock off
  179. endp
  180.  
  181. proc domenu:
  182. local ret%
  183.  
  184.     minit
  185.     mcard "File","New file",%n,"Open file",-%o,"Rename file",%N,"Copy file",%C,"Insert file",-%I,"Write region",-%w,"Revert",%V
  186.     mcard "Edit","Insert region",%i,"Copy region",%c,"Cut region",%d
  187.     mcard "Play/Record","Play whole sample",%p,"Play region",-%P,"Record and insert",%r,"Record and replace",-%R,"Volume",%v
  188.     mcard "Speed","Double speed sample",%g,"Double speed range",-%G,"Half speed sample",%h,"Half speed range",%H
  189.     mcard "Function","Fade region in",%f,"Fade region out",-%F,"Reverse sample",%t,"Reverse region",-%T,"Filter sample",%l,"Filter range",-%L,"Phase sample",%s,"Phase range",%S
  190.     mcard "Special","Zoom region in",%z,"Zoom out",-%Z,"About WaveMod",-%a,"Exit",%x
  191.     return menu
  192.  
  193. endp
  194.  
  195. proc drawcurs:(cx%,cw%)
  196.  
  197.     gat cx%,4
  198.     gfill cw%,gheight-8,2
  199.     
  200.     gat cx%-2,0
  201.     gfill 5,4,2
  202.  
  203.     gat cx%-2,gheight-4
  204.     gfill 5,4,2
  205.     
  206.     if cw%>1
  207.         gat cx%+cw%-2,0
  208.         gfill 5,4,2
  209.         gat cx%+cw%-2,gheight-4
  210.         gfill 5,4,2
  211.     endif
  212.  
  213. endp
  214.  
  215. proc dispprog:(fp&,len&)
  216.  
  217.     busy "Processing... ("+num$((fp&*100)/len&,3)+"%)"
  218.  
  219. endp
  220.  
  221.  
  222.  
  223. proc dohelp:
  224.     dinit "WaveMod Help"
  225.     dtext "","Movement:",$100
  226.     dtext "","-----------------",2
  227.     dtext "","Cursor keys move the cursor.",0
  228.     dtext "","Shifted cursor keys mark a region.",0
  229.     dtext "","Shift-psion-cursor keys alter region's left margin.",0
  230.     dtext "","Ctrl-(above) accelerates cursor movement.",0
  231.     dtext "","-----------------",2
  232.     dialog
  233.     
  234.     dinit "WaveMod Help"
  235.     dtext "","Zooming:",$100
  236.     dtext "","-----------------",2
  237.     dtext    "","Mark a region and then press Psion-Z",0
  238.     dtext    "","to zoom it in. Psion-Shift-Z will zoom out",0
  239.     dtext    "","by two. If no region is marked then",0
  240.     dtext    "","Psion-Z will zoom out to full size.",0
  241.     dtext "","-----------------",2
  242.     dialog
  243.  
  244.     dinit "WaveMod Help"
  245.     dtext "","Safety:",$100
  246.     dtext "","-----------------",2
  247.     dtext    "","Before making a change you will always",0
  248.     dtext    "","be prompted whether to make a backup",0
  249.     dtext    "","or not. Answering yes will allow you to",0
  250.     dtext    "","use Psion-Shift-V to revert to the backup.",0
  251.     dtext "","The backup file is deleted when you exit.",0
  252.     dtext "","-----------------",2
  253.     dialog
  254. endp
  255.  
  256.