# # sos.icn - Clean Co-expression Edition # by Jeffery, starting from Wilder's code # # # monitor event codes # $define Eo_Min (256) $define Eo_Cmp (Eo_Min + 0) $define Eo_Swp (Eo_Min + 1) $define Eo_Nop (Eo_Min + 2) $define Eo_Piv (Eo_Min + 3) $define Eo_Rng (Eo_Min + 4) $define Eo_Max (Eo_Rng) global c_qs,c_bs global mon_tick_ms global wnd_h,scale global bg_hue,fg_hue global qs_wnd,bs_wnd global piv_hue,rng_hue global cmp_1_hue,cmp_2_hue global q_rng_last_min,q_rng_last_max # # Draw a bar in window at x,y in hue. # procedure bar(wnd, x, y, hue) Fg(wnd, \hue) FillRectangle(wnd, x*20 + 5, wnd_h - y*scale, 10, y*scale) Fg(wnd, fg_hue) end # # flush i/o in window and delay # procedure mon_delay(wnd) WFlush(wnd) # useful on X11 if mon_tick_ms <= 0 then Event(wnd) else delay(mon_tick_ms) end # # generate a "target program" event in child co-expr # procedure tp_event(a,b,c,d,e) [a,b,c,d,e] @ &main end # # service a "monitor" event in the main co-expression # procedure mon_event(opcode, wnd, lhs, rhs, data) case opcode of { Eo_Cmp: { # draw lhs in new state bar(wnd, lhs-1, data[lhs], cmp_1_hue) # draw rhs in new state bar(wnd, rhs-1, data[rhs], cmp_2_hue) mon_delay(wnd) } Eo_Nop: { bar(wnd, lhs-1, data[lhs]) bar(wnd, rhs-1, data[rhs]) mon_delay(wnd) } Eo_Piv: { # draw pivot in new state bar(wnd, lhs-1, data[lhs], piv_hue) } Eo_Rng: { # draw old min,max,piv in fg color bar(wnd, q_rng_last_min-1, data[q_rng_last_min]) bar(wnd, q_rng_last_max-1, data[q_rng_last_max]) # draw new min,max in new color bar(wnd, lhs-1, data[lhs], rng_hue) bar(wnd, rhs-1, data[rhs], rng_hue) # save info about last range q_rng_last_min := lhs q_rng_last_max := rhs mon_delay(wnd) } Eo_Swp: { # hide lhs and rhs in old state bar(wnd, rhs-1, data[lhs], bg_hue) bar(wnd, lhs-1, data[rhs], bg_hue) # draw lhs in new state bar(wnd, lhs-1, data[lhs], cmp_2_hue) # draw rhs in new state bar(wnd, rhs-1, data[rhs], cmp_1_hue) mon_delay(wnd) # operation has completed. # redraw both sides in "normal" color mon_event(Eo_Nop, wnd, lhs, rhs, data) } default: { write("mon-event: bad opcode: ", opcode) exit(-1) } } return end procedure bubblesort(L) every i := 1 to *L do { every j := *L to i + 1 by -1 do { tp_event(Eo_Cmp, bs_wnd, j, j-1, L) if L[j] < L[j-1] then { L[j] :=: L[j-1] tp_event(Eo_Swp, bs_wnd, j, j-1, L) } else tp_event(Eo_Nop, bs_wnd, j, j-1, L) } tp_event(Eo_Piv, bs_wnd, i,,L) } return L end procedure qsort(L, first, last) /first := 1 /last := *L i := first j := last if i = j then return L pivot := L[(i + j) / 2] tp_event(Eo_Rng, qs_wnd, i, j, L) repeat { while L[i] < pivot do { i +:= 1 tp_event(Eo_Rng, qs_wnd, i, j, L) } while pivot < L[j] do { j -:= 1 tp_event(Eo_Rng, qs_wnd, i, j, L) } tp_event(Eo_Cmp, qs_wnd, i, j, L) if i <= j then { L[i] :=: L[j] tp_event(Eo_Swp, qs_wnd, i, j, L) i +:= 1 j -:= 1 } else tp_event(Eo_Nop, qs_wnd, i, j, L) if i > j then break } if first < j then qsort(L, first, j) if i < last then qsort(L, i, last) return L end procedure main(args) # # determine program parameters # mon_tick_ms := integer(\args[1]) | 10 wnd_w := args[2] | "800" wnd_h := args[3] | "300" bg_hue := args[4] | "black" fg_hue := args[5] | "dark yellow" cmp_1_hue := args[6] | "blue" cmp_2_hue := args[7] | "red" piv_hue:= args[8] | "very dark yellow" rng_hue := piv_hue scale := wnd_h * 0.01 q_rng_last_min := q_rng_last_max := 0 write("mon-tick-ms: ", mon_tick_ms) # # make quicksort window # qs_wnd := open("quick-sort", "g", "size="||wnd_w||","||wnd_h, "bg="||bg_hue, "fg="||fg_hue ) | stop("can't open") # # make bubblesort window # bs_wnd := open("bubble-sort", "g", "size="||wnd_w||","||wnd_h, "bg="||bg_hue, "fg="||fg_hue ) # # create and populate lists # L := [: !40 & ?100 :] L2 := copy(L) # # draw initial state of windows # every bar(qs_wnd, (i := !*L)-1, L[i]) every bar(bs_wnd, (i := !*L2)-1, L2[i]) # # init coexprs # c_qs := create qsort(L) c_bs := create bubblesort(L2) # # wait until user provokes an event in the quicksort window # Event(qs_wnd) # # process coexprs # while (x := @\c_qs) & (y := @\c_bs) do { if x === L then c_qs := &null else mon_event ! \x if y === L2 then c_bs := &null else mon_event ! \y } while (x:=@\c_qs) ~===L do mon_event ! \x while (y:=@\c_bs) ~=== L2 do mon_event ! \y # wait for escape or "q" key while not (Event(qs_wnd) === ("\e"|"q")) end