Report abuse

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
#!/usr/bin/env ruby -wKU

require "strscan"

module BASIC
  class Instruction
    LINE_NUMBER_RE = /\d+/
    VARIABLE_RE    = /[A-Z]\w*/
    EXPRESSION_RE  = /[^:;]+/
    
    def self.parse(number, code)
      instructions = [ ]
      lexer        = StringScanner.new(code)
      loop do
        if lexer.scan(/REM (.+)/)
          instructions << REMInstruction.new(number, lexer[1])
        elsif lexer.scan(/PRINT\s*/)
          arguments = [ ]
          while lexer.scan(/("[^"]+"|#{EXPRESSION_RE};|#{VARIABLE_RE})\s*;?\s*/)
            arguments << lexer[1]
          end
          instructions << PRINTInstruction.new(number, arguments)
        elsif lexer.scan(/(#{VARIABLE_RE})\s*=\s*(#{EXPRESSION_RE})\s*/)
          instructions << AssignmentInstruction.new(number, lexer[1], lexer[2])
        elsif lexer.scan(/IF (#{EXPRESSION_RE}) THEN (#{LINE_NUMBER_RE})\s*/)
          instructions << IFGOTOInstruction.new(number, lexer[1], lexer[2].to_i)
        elsif lexer.scan(/INPUT (#{VARIABLE_RE})\s*/)
          instructions << INPUTInstruction.new(number, lexer[1])
        elsif lexer.scan(/GOSUB (#{LINE_NUMBER_RE})\s*/)
          instructions << GOSUBInstruction.new(number, lexer[1].to_i)
        elsif lexer.scan(/GOTO (#{LINE_NUMBER_RE})\s*/)
          instructions << GOTOInstruction.new(number, lexer[1].to_i)
        elsif lexer.scan(/RETURN\s*/)
          instructions << RETURNInstruction.new(number)
        elsif lexer.scan( /FOR\s(#{VARIABLE_RE})\s*=\s*(#{EXPRESSION_RE})\s
                                                   TO\s(#{EXPRESSION_RE})\s*/x )
          instructions << FORInstruction.new( number, lexer[1],
                                                      lexer[2],
                                                      lexer[3] )
        elsif lexer.scan(/NEXT (#{VARIABLE_RE})\s*/)
          instructions << NEXTInstruction.new(number, lexer[1])
        elsif lexer.scan(/END\s*/)
          instructions << ENDInstruction.new(number)
        elsif lexer.scan(/\s*[:;]\s*/)  # another instruction may follow
          next
        elsif lexer.eos?                # parsed all of the code
          break
        else
          raise "Failed to parse:  #{number} #{code}"
        end
      end
      case instructions.size
      when 1
        instructions.first
      when 2..1.0/0.0
        MultiInstruction.new(number, instructions)
      else
        raise "Empty instruction"
      end
    end
    
    def initialize(number)
      @number = number
    end
    
    attr_reader :number
    
    def run(program)
      @number + 1
    end
  end
  
  def self.instruction(name, *init_args, &run_body)
    instruction_class = Class.new(Instruction) do
      define_method(:initialize) do |number, *args|
        unless args.size == init_args.size
          raise ArgumentError,
                "wrong number of arguments (#{args.size} for #{init_args.size})"
        end
        super(number)
        init_args.zip(args) do |variable, value|
          instance_variable_set("@#{variable}", value)
        end
      end
      define_method(:run, &run_body) if run_body
    end
    const_set("#{name}Instruction", instruction_class)
  end
  
  instruction(:REM, :comment)
  
  instruction(:PRINT, :arguments) do |program|
    @arguments.each do |argument|
      case argument[-1, 1]
      when '"'
        print argument[1..-2]
      when ';'
        print program.evaluate_expression(argument[0..-2])
      else
        print program.variables[argument]
      end
      print " "
    end
    puts
    super
  end
  
  instruction(:Assignment, :variable, :expression) do |program|
    program.variables[@variable] = program.evaluate_expression(@expression)
    super
  end
  
  instruction(:IFGOTO, :condition, :target) do |program|
    left, operator, right = @condition.split(/(<=|>=|<>|<|>|=)/)
    operator              = "==" if operator == "="
    left, right           = [left, right].
                            map { |exp| program.evaluate_expression(exp) }
    if operator == "<>" ? left != right : left.send(operator, right)
      (@goto ||= GOTOInstruction.new(@number, @target)).run(program)
    else
      super
    end
  end
  
  instruction(:INPUT, :variable) do |program|
    program.variables[@variable] = gets.to_i
    super
  end
  
  instruction(:GOSUB, :target) do |program|
    program.stack << super
    (@goto ||= GOTOInstruction.new(@number, @target)).run(program)
  end
  
  instruction(:GOTO, :target) do
    @target
  end
  
  instruction(:RETURN) do |program|
    program.stack.pop
  end
  
  instruction(:FOR, :variable, :from, :to) do |program|
    if not program.variables.include? @variable
      program.variables[@variable] =  program.evaluate_expression(@from)
      program.stack                << number
    else
      @return ||= RETURNInstruction.new(@number)
      program.variables[@variable] += 1
      if program.variables[@variable] > program.evaluate_expression(@to)
        program.variables.delete(@variable)
        @return.run(program)
      else
        @return.run(program)  # discard since we're not done looping
        super
      end
    end
  end
  
  instruction(:NEXT, :variable) do |program|
    for_loop      =  (@return ||= RETURNInstruction.new(@number)).run(program)
    program.stack << super
    for_loop
  end
  
  instruction(:END) do
    exit
  end
  
  class MultiInstruction < Instruction
    def initialize(number, instructions)
      super(number)
      @instructions = instructions
    end
    
    def run(program)
      @instructions.each do |instruction|
        if [GOSUBInstruction, GOTOInstruction].include? instruction.class
          return instruction.run(program)
        else
          instruction.run(program)
        end
      end
      super
    end
  end
  
  class Program
    def initialize(code)
      @instructions        = { }
      @current_instruction = 0
      @variables           = { }
      @stack               = [ ]
      parse(code)
    end
    
    attr_reader :variables, :stack
    
    def run
      loop do
        @current_instruction = next_instruction.run(self)
      end
    end
    
    def evaluate_expression(expression)
      evaluate_terms(parse_expression(expression))
    end
    
    private
    
    def parse(code)
      code.grep(/^(#{Instruction::LINE_NUMBER_RE})\s+(.+)$/) do
        instruction                       = Instruction.parse($1.to_i, $2)
        @instructions[instruction.number] = instruction
      end
    end
    
    def parse_expression(expression)
      lexer = StringScanner.new(expression)
      terms = [ ]
      loop do
        if lexer.scan(/CHR\$\((\d+)\)\s*/)
          terms << lexer[1].to_i.chr
        elsif lexer.scan(/INT\(\s*/)
          terms << "INT("
        elsif lexer.scan(/RND\(\s*/)
          terms << "RND("
        elsif lexer.scan(/\(\s*/)
          terms << "("
        elsif lexer.scan(/\)\s*/)
          if i = terms.rindex(terms.reverse.find { |t| t.is_a?(String) and
                                                       t =~ /\(\z/ })
            terms = terms[0...i] +
                    [[terms[i][/\w+/], *terms[(i + 1)..-1]].compact]
          else
            abort "Bad () expression:  #{expression}"
          end
        elsif lexer.scan(/(\d*\.\d+)\s*/)
          terms << lexer[1].to_f
        elsif lexer.scan(/(\d+)\s*/)
          terms << lexer[1].to_i
        elsif lexer.scan(/(#{Instruction::VARIABLE_RE})\s*/)
          terms << @variables[lexer[1]].to_i
        elsif lexer.scan(/([-+*\/])\s*/)
          terms << lexer[1]
        elsif lexer.eos?
          break
        else
          abort "Choked on:  #{expression}"
        end
      end
      terms
    end
    
    def evaluate_terms(terms)
      return rand(terms.last) if terms.first == "RND" and terms.size == 2
      int   = terms.first == "INT" ? terms.shift : false
      total = terms.first.is_a?(Array) ? evaluate_terms(terms.shift) :
                                         terms.shift
      (0...terms.size).step(2) do |i|
        operand = terms[i + 1].is_a?(Array) ? evaluate_terms(terms[i + 1]) :
                                              terms[i + 1]
        if terms[i] == "/"
          total /= operand.to_f
        else
          total = total.send(terms[i], operand)
        end
      end
      int ? total.to_i : total
    end
    
    def next_instruction
      if instruction = @instructions[@current_instruction]
        instruction
      elsif i = @instructions.keys.
                              select { |step| step > @current_instruction }.
                              sort.
                              first
        @instructions[@current_instruction = i]
      else
        raise "End of Instructions"
      end
    end
  end
end

BASIC::Program.new(DATA).run

__END__
10 REM *** CONVERTED FROM THE ORIGINAL FOCAL PROGRAM AND MODIFIED
20 REM *** FOR EDUSYSTEM 70 BY DAVID AHL, DIGITAL
30 REM *** MODIFIED FOR 8K MICROSOFT BASIC BY PETER TURNBULL
80 PRINT "TRY YOUR HAND AT GOVERNING ANCIENT SUMERIA"
85 PRINT "SUCCESSFULLY FOR A 10-YR TERM OF OFFICE.":PRINT
90 REM RANDOMIZE REMOVED
95 D1=0:P1=0
110 Z=0:P=95:S=2800:H=3000:E=H-S
120 Y=3:A=H/Y:I=5:Q=1
210 D=0
215 PRINT:PRINT:PRINT "HAMURABI:  I BEG TO REPORT TO YOU,":Z=Z+1
217 PRINT "IN YEAR"Z","D"PEOPLE STARVED,"I"CAME TO THE CITY."
218 P=P+I
227 IF Q>0 THEN 230
228 P=INT(P/2)
229 PRINT "A HORRIBLE PLAGUE STRUCK!  HALF THE PEOPLE DIED."
230 PRINT "POPULATION IS NOW"P 
232 PRINT "THE CITY NOW OWNS"A"ACRES."
235 PRINT "YOU HARVESTED"Y"BUSHELS PER ACRE."
250 PRINT "RATS ATE"E"BUSHELS."
260 PRINT "YOU NOW HAVE"S"BUSHELS IN STORE.":PRINT
270 IF Z=11 THEN 860
310 C=INT(10*RND(1)):Y=C+17
312 PRINT "LAND IS TRADING AT"Y"BUSHELS PER ACRE."
320 PRINT "HOW MANY ACRES DO YOU WISH TO BUY";
321 INPUT Q:IF Q<0 THEN 850
322 IF Y*Q<=S THEN 330
323 GOSUB 710
324 GOTO 320 
330 IF Q=0 THEN 340
331 A=A+Q:S=S-Y*Q:C=0
334 GOTO 400
340 PRINT "HOW MANY ACRES DO YOU WISH TO SELL";
341 INPUT Q:IF Q<0 THEN 850
342 IF Q<A THEN 350
343 GOSUB 720
344 GOTO 340 
350 A=A-Q:S=S+Y*Q:C=0
400 PRINT
410 PRINT "HOW MANY BUSHELS DO YOU WISH TO FEED YOUR PEOPLE";
411 INPUT Q
412 IF Q<0 THEN 850
418 REM *** TRYING TO USE MORE GRAIN THAN IN THE SILOS?
420 IF Q<=S THEN 430 
421 GOSUB 710
422 GOTO 410 
430 S=S-Q:C=1:PRINT
440 PRINT "HOW MANY ACRES DO YOU WISH TO PLANT WITH SEED";
441 INPUT D:IF D=0 THEN 511
442 IF D<0 THEN 850
444 REM *** TRYING TO PLANT MORE ACRES THAN YOU OWN?
445 IF D<=A THEN 450
446 GOSUB 720
447 GOTO 440
449 REM *** ENOUGH GRAIN FOR SEED?
450 IF INT(D/2)<S THEN 455
452 GOSUB 710
453 GOTO 440 
454 REM *** ENOUGH PEOPLE TO TEND THE CROPS?
455 IF D<10*P THEN 510
460 PRINT "BUT YOU HAVE ONLY"P"PEOPLE TO TEND THE FIELDS. NOW THEN,"
470 GOTO 440
510 S=S-INT(D/2)
511 GOSUB 800
512 REM *** A BOUNTYFULL HARVEST!!
515 Y=C:H=D*Y:E=0
521 GOSUB 800
522 IF INT(C/2)<>C/2 THEN 530
523 REM *** THE RATS ARE RUNNING WILD!!
525 E=INT(S/C)
530 S=S-E+H
531 GOSUB 800
532 REM *** LET'S HAVE SOME BABIES
533 I=INT(C*(20*A+S)/P/100+1)
539 REM *** HOW MANY PEOPLE HAD FULL TUMMIES?
540 C=INT(Q/20)
541 REM *** HORRORS, A 15% CHANCE OF PLAGUE
542 Q=INT(10*(2*RND(1)-.3))
550 IF P<C THEN 210
551 REM *** STARVE ENOUGH FOR IMPEACHMENT?
552 D=P-C:IF D>.45*P THEN 560
553 P1=((Z-1)*P1+D*100/P)/Z
555 P=C:D1=D1+D:GOTO 215
560 PRINT:PRINT "YOU STARVED"D"PEOPLE IN ONE YEAR!!!"
565 PRINT "DUE TO THIS EXTREME MISMANAGEMENT YOU HAVE NOT ONLY"
566 PRINT "BEEN IMPEACHED AND THROWN OUT OF OFFICE BUT YOU HAVE"
567 PRINT "ALSO BEEN DECLARED 'NATIONAL FINK' !!":GOTO 990
710 PRINT "HAMURABI:  THINK AGAIN. YOU HAVE ONLY"
711 PRINT S"BUSHELS OF GRAIN.  NOW THEN,"
712 RETURN 
720 PRINT "HAMURABI:  THINK AGAIN. YOU OWN ONLY"A"ACRES.  NOW THEN,"
730 RETURN
800 C=INT(RND(1)*5)+1
801 RETURN 
850 PRINT:PRINT "HAMURABI:  I CANNOT DO WHAT YOU WISH."
855 PRINT "GET YOURSELF ANOTHER STEWARD!!!!!"
857 GOTO 990
860 PRINT "IN YOUR 10-YEAR TERM OF OFFICE,"P1"PERCENT OF THE"
862 PRINT "POPULATION STARVED PER YEAR ON AVERAGE, I.E., A TOTAL OF"
865 PRINT D1"PEOPLE DIED!!":L=A/P
870 PRINT "YOU STARTED WITH 10 ACRES PER PERSON AND ENDED WITH"
875 PRINT L"ACRES PER PERSON.":PRINT
880 IF P1>33 THEN 565
885 IF L<7 THEN 565
890 IF P1>10 THEN 940
892 IF L<9 THEN 940
895 IF P1>3 THEN 960
896 IF L<10 THEN 960
900 PRINT "A FANTASTIC PERFORMANCE!!!  CHARLEMANGE, DISRAELI, AND"
905 PRINT "JEFFERSON COMBINED COULD NOT HAVE DONE BETTER!":GOTO 990
940 PRINT "YOUR HEAVY-HANDED PERFORMANCE SMACKS OF NERO AND IVAN IV."
945 PRINT "THE PEOPLE (REMAINING) FIND YOU AN UNPLEASANT RULER, AND,"
950 PRINT "FRANKLY, HATE YOUR GUTS!":GOTO 990
960 PRINT "YOUR PERFORMANCE COULD HAVE BEEN SOMEWHAT BETTER, BUT"
965 PRINT "REALLY WASN'T TOO BAD AT ALL. ";
966 PRINT INT(P*.8*RND(1));"PEOPLE WOULD"
970 PRINT "DEARLY LIKE TO SEE YOU ASSASSINATED BUT WE ALL HAVE OUR"
975 PRINT "TRIVIAL PROBLEMS."
990 PRINT:FOR N=1 TO 10:PRINT CHR$(7);:NEXT N
995 PRINT "SO LONG FOR NOW.":PRINT
999 END