home *** CD-ROM | disk | FTP | other *** search
/ ST-Computer Leser 2002 January / STC_CD_01_2002.iso / GAMES / DGEM / DGEM_DEV / DGEMDEV / DMAKE / MAKEFILE.GFA (.txt) < prev    next >
GFA-BASIC Atari  |  2001-12-10  |  3KB  |  141 lines

  1. RESERVE 512000
  2. '
  3. line_max&=2000
  4. column_max&=32
  5. '
  6. DIM line$(line_max&)
  7. LET nb_line%=0
  8. '
  9. DIM column_type&(column_max&)
  10. DIM column_length&(column_max&)
  11. LET column_number&=0
  12. LET structure_length&=0
  13. LET structure_number&=0
  14. '
  15. LET output$=""
  16. '
  17. ordre$=CHAR{ADD(BASEPAGE,128)}
  18. ordre$=MID$(ordre$,2,ASC(ordre$))
  19. ordre$=ordre$+CHR$(0)
  20. IF @s_exist(ordre$)
  21.   OPEN "i",#1,ordre$
  22.   RECALL #1,line$(),-1,nb_line%
  23.   CLOSE #1
  24. ELSE
  25.   ~FORM_ALERT(1,"[1]["+ordre$+" not found.][Cancel]")
  26.   QUIT
  27. ENDIF
  28. '
  29. output$=@find$("FILENAME")
  30. IF INSTR(output$,":\")=0
  31.   output$=LEFT$(ordre$,RINSTR(ordre$,"\"))+output$
  32. ENDIF
  33. '
  34. separator$=@find$("SEPARATOR")
  35. '
  36. FOR i&=0 TO PRED(column_max&)
  37.   column_type$=UPPER$(@find$("COLUMN"+STR$(SUCC(i&))))
  38.   IF column_type$="INT"
  39.     column_length&(i&)=2
  40.     column_type&(i&)=1
  41.     INC column_number&
  42.   ELSE IF column_type$="LONG"
  43.     column_length&(i&)=4
  44.     column_type&(i&)=2
  45.     INC column_number&
  46.   ELSE IF LEFT$(column_type$,4)="CHAR"
  47.     column_length&(i&)=VAL(MID$(column_type$,6))
  48.     INC column_length&(i&) ! for the final nullbyte
  49.     IF ODD(column_length&(i&)) ! respect parity to avoid call on odd pointer
  50.       INC column_length&(i&)
  51.     ENDIF
  52.     column_type&(i&)=3
  53.     INC column_number&
  54.   ENDIF
  55.   EXIT IF LEN(column_type$)=0
  56.   ADD structure_length&,column_length&(i&)
  57. NEXT i&
  58. '
  59. adr%=GEMDOS(72,L:MUL(nb_line%,structure_length&))
  60. IF adr%>0
  61.   structure_number&=0
  62.   FOR i&=0 TO PRED(nb_line%)
  63.     '
  64.     a$=LEFT$(TRIM$(line$(i&)))
  65.     IF LEN(a$)>0 AND a$<>"@" AND a$<>"#"
  66.       a$=line$(i&)
  67.       IF INSTR(a$,"#")>0
  68.         a$=TRIM$(LEFT$(a$,PRED(INSTR(a$,"#"))))
  69.       ENDIF
  70.       ptr%=ADD(adr%,MUL(structure_length&,structure_number&))
  71.       FOR j&=0 TO PRED(column_number&)
  72.         pos&=INSTR(a$,separator$)
  73.         '
  74.         column_value$=LEFT$(a$,PRED(pos&))
  75.         SELECT column_type&(j&)
  76.         CASE 1
  77.           INT{ptr%}=VAL(column_value$)
  78.         CASE 2
  79.           LONG{ptr%}=VAL(column_value$)
  80.         CASE 3
  81.           IF SUCC(LEN(column_value$))>column_length&(j&)
  82.             ~FORM_ALERT(1,"[1][CHAR overflow at line "+STR$(i&)+".][Cancel]")
  83.           ELSE
  84.             CHAR{ptr%}=STRING$(PRED(column_length&(j&)),CHR$(0))
  85.             CHAR{ptr%}=column_value$
  86.           ENDIF
  87.         ENDSELECT
  88.         '
  89.         ADD ptr%,column_length&(j&)
  90.         a$=MID$(a$,SUCC(pos&))
  91.       NEXT j&
  92.       INC structure_number&
  93.     ENDIF
  94.     '
  95.   NEXT i&
  96.   '
  97.   IF structure_number&>0
  98.     OPEN "o",#1,output$
  99.     BPUT #1,adr%,MUL(structure_number&,structure_length&)
  100.     CLOSE #1
  101.   ENDIF
  102.   '
  103.   ~GEMDOS(73,L:adr%)
  104.   ~FORM_ALERT(1,"[1][ Work completed on "+STR$(structure_number&)+" records. ][ Okay ]")
  105. ELSE
  106.   ~FORM_ALERT(1,"[1][Not enough memory.][Cancel]")
  107. ENDIF
  108. QUIT 0
  109. '
  110. > FUNCTION find$(str$)
  111.   LOCAL tmp&,tmp$,str_len&,line&
  112.   str$="@"+str$+"="
  113.   str_len&=LEN(str$)
  114.   tmp&=MIN(100,PRED(nb_line%))
  115.   FOR line&=0 TO tmp&
  116.     IF LEFT$(line$(line&),str_len&)=str$
  117.       tmp$=MID$(line$(line&),SUCC(str_len&))
  118.       IF INSTR(tmp$,"#")>0
  119.         RETURN TRIM$(LEFT$(tmp$,PRED(INSTR(tmp$,"#"))))
  120.       ELSE
  121.         RETURN TRIM$(tmp$)
  122.       ENDIF
  123.     ENDIF
  124.   NEXT line&
  125.   RETURN ""
  126. ENDFUNC
  127. > FUNCTION s_exist(exist_name$)
  128.   LOCAL existe&
  129.   IF LEN(exist_name$)=0 OR exist_name$=c0$
  130.     RETURN FALSE
  131.   ELSE
  132.     existe&=GEMDOS(61,L:V:exist_name$,W:0)
  133.     IF existe&>0
  134.       ~GEMDOS(62,W:existe&)
  135.       RETURN TRUE
  136.     ELSE
  137.       RETURN FALSE
  138.     ENDIF
  139.   ENDIF
  140. ENDFUNC
  141.