home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #3 / NN_1993_3.iso / spool / comp / lang / forth / 3945 < prev    next >
Encoding:
Internet Message Format  |  1993-01-21  |  2.7 KB
  1. Path: sparky!uunet!gatech!pitt!willett!ForthNet
  2. From: ForthNet@willett.pgh.pa.us (ForthNet articles from GEnie)
  3. Newsgroups: comp.lang.forth
  4. Subject: Help for F-PC and TCOM
  5. Message-ID: <4267.UUL1.3#5129@willett.pgh.pa.us>
  6. Date: 21 Jan 93 11:33:39 GMT
  7. Organization: EIEI-U
  8. Lines: 109
  9.  
  10. Category 7,  Topic 35
  11. Message 31        Wed Jan 20, 1993
  12. ELLIOTT.C                    at 18:09 EST
  13.  
  14.  -----via CRS Premium Bulletin Board -
  15.  USR Dual Standard 16.8K  (416) 629-7000
  16.  
  17.  Date: 01-10-93 (12:15)
  18.    To: ALL
  19.  From: M SIMON
  20.  Subj: PROGRAMMING PROBLEM FPC
  21.  
  22.  I tried the following program which I cribbed from the files
  23.  included with FPC (PDP-8 stuff). It does not open a file which is
  24.  known to reside in the same directory as FPC. No error message is
  25.  returned. HOPEN indicates success opening the file. I am stumped.
  26.  
  27.  
  28.  M. Simon / Space-Time Productions
  29.  3124 Meriday    Suite 103
  30.  Rockford, Illinois 61109
  31.  [ 815 ]  874-2296
  32.  
  33.  /// this space for lend, lease, sale, rent, or time \\\
  34.  
  35.  
  36.  handle ofile      \ output file handle
  37.  
  38.  : ofile-msg       cr  ." Enter filename: "     cr  ;
  39.  : open-err-msg    cr  ." Can't find source file. "   cr    ;
  40.  : retry-msg       cr  ." Hit any key to retry. "     cr  ;
  41.  
  42.  
  43.  \ string input function
  44.  40 constant max_length
  45.  create str-buf  max_length allot
  46.  : clr-str-buf str-buf max_length erase ;
  47.  
  48.  
  49.  : length-s    ( adr --- count )
  50.          max_length  0
  51.          do dup i + c@ 0=
  52.                if i leave
  53.                then
  54.          loop swap drop ;
  55.  
  56.  
  57.  \ get user input string and store as counted string at addr
  58.  : accept    ( addr n  ---  )
  59.          clr-str-buf
  60.          over 1+ dup rot
  61.          expect length-s
  62.          swap c! ;
  63.  
  64.  
  65.  : input-filename
  66.           str-buf
  67.           40 accept ;
  68.  
  69.  
  70.  : abort-key      ( --- )
  71.          key drop  ;
  72.  
  73.  
  74.   : get_ofile_name  ( --- )
  75.          ofile
  76.          clr-hcb
  77.          ofile-msg
  78.          input-filename
  79.          str-buf
  80.          ofile
  81.          $>handle
  82.    ;
  83.  
  84.  
  85.  
  86.  : open_ofile    ( --- f )
  87.          ofile
  88.          hopen
  89.          if
  90.             cr open-err-msg
  91.             cr retry-msg
  92.             abort-key
  93.             false
  94.          else
  95.             true
  96.          then
  97.    ;
  98.  
  99.  
  100.  : GET-FILE  ( --- f )
  101.         get_ofile_name
  102.         open_ofile
  103.  ;
  104.  
  105.            Thanks for the help,
  106.            M. Simon
  107.  
  108.  NET/Mail : RCFB Golden, CO (303) 278-0364 VESTA & Denver FIG for
  109.  Forth! ---
  110.   * The GrapeVine/Ferret Face BBS * NLR,ARK * 501-753-8121 DS *
  111.   * PostLink(tm) v1.04  GRAPEVINE (#318) : RelayNet(tm) Hub  
  112.  
  113.  
  114. -----
  115. This message came from GEnie via willett.  You *cannot* reply to the author
  116. using e-mail.  Please post a follow-up article, or use any instructions
  117. the author may have included (USMail addresses, telephone #, etc.).
  118. Report problems to: dwp@willett.pgh.pa.us
  119.