home *** CD-ROM | disk | FTP | other *** search
/ Set of Apple II Hard Drive Images / hard.hdv / HARD / FORTH / LOADSAV1.WRD < prev    next >
Encoding:
Text File  |  1992-12-13  |  1.8 KB  |  68 lines  |  [04] ASCII Text (0x0000)
  1. ( LOADING AND SAVING SEQUENCES )
  2.  
  3. HEX
  4.  
  5. FORTH DEFINITIONS
  6.  
  7.  
  8. ( SYNTAX: PREFIX" /PATHNAME" )
  9.  
  10. : PREFIX"
  11.    1 PAD C! ASCII " WORD PAD 1+ ! PAD C6 MLI
  12. ;
  13.  
  14.  
  15. : BSAVE"  ( START.ADRS LENGTH -- )
  16.    OVER                         ( ADRS LEN ADRS )
  17.    ASCII " WORD DUP             ( ADRS LEN ADRS WORD WORD )
  18.    ROT                          ( ADRS LEN WORD WORD ADRS )
  19.    6 ( BIN ) SWAP               ( ADRS LEN WORD WORD 6 ADRS )
  20.    ( CREATEF USES TOP 3 PARMS, OPENF USES WORD, WRITEF USES ADRS,LEN )
  21.    (CREATEF) ?DERR \ CREATE NEW FILE 
  22.    (OPENF) ?DERR   \ PASS PATHNAME - RETURN FILE#
  23.    (WRITEF) ?DERR  \ WRITE THE BINARY DATA TO THE FILE
  24.    0 (CLOSEF) ?DERR
  25. ;
  26.  
  27.  
  28. ( SYNTAX: <SEQ-WORD> SAVESEQ" /PATHNAME" )
  29. ( SAVES FROM STARTADRS-2 )
  30.  
  31. : SAVESEQ" ( START.ADRS LENGTH -- )
  32.    2+ SWAP 2 - SWAP  BSAVE"
  33.    ( GET START.ADRS-2 WHICH POINTS TO LENGTH BYTE ==> AUXTYPE)
  34. ;
  35.  
  36.  
  37. ( SYNTAX:  SEQUENCE NEWWORD   LOADSEQ" PART1"  LOADSEQ" PART2"   END-SEQ )
  38. : BLOAD"                   
  39.    ASCII " WORD              ( GET PATHNAME )
  40.    (OPENF) ?DERR  DUP        ( OPENF RETURNS FILE# -- SAVE A COPY FOR LATER)
  41.    (EOF) ?DERR               ( --- F#, D.EOF )
  42.    DROP DUP HERE SWAP ALLOT ( SAVE HERE & ALLOT USING LO 16 BITS FROM EOF)
  43.    SWAP ROT                 ( SETUP START.ADRS, LENGTH, AND FILE# )
  44.    (READF) ?DERR             ( GET REST OF FILE )
  45.    0 (CLOSEF) ?DERR          ( CLOSE IT)   
  46. ;
  47.  
  48.  
  49. ( CONVERSION TO MIDI FILE FORMAT )
  50.  
  51. ( SYNTAX: SEQUENCE NEWWORD   OLDWORD MIDIPASTE   END-SEQ  )
  52.  
  53. : CHKDRTN ( ADRS -- )
  54.    @ DUP 80 < IF C, ELSE DUP 80 / 80 + C, 80 MOD C, THEN
  55. ;
  56.  
  57. : CHKNOTES ( ADRS -- )
  58.    2+ C@ C, DUP 3+ C@ C,
  59. ;
  60.  
  61. : MIDIPASTE  ( START.ADDR LENGTH -- )
  62.    4 /                       ( GET NUMBER OF EVENTS )
  63.    0 C, 90 C, 0 C, 0 C,      ( START MIDISEQ WITH STATUS BYTE )
  64.    0 DO DUP CHKDRTN DUP CHKNOTES 4 + LOOP
  65.    0 C, FF C, 2F C,           ( STORE END OF MIDI SEQ )
  66. ;
  67.  
  68. DEC